请问如何通过VBA提取固定格式的单元格内容？

roseland

求助，请问如何通过VBA提取固定格式的单元格内容？

模板中工作页"LoyaltyTransactionsEarn"为固定格式，系统下载下来时最多有100行。

请问如何将工作页"LoyaltyTransactionsEarn"中标了绿色的列，提取到工作页”简易打印报表"。

如果100行，是否用VBA会更快？

金樽空对月

VBA肯定会更快一些

hasyh2008

Sub 转置()
    Dim Rc%
    Rc = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    Sheet1.Range("A5:BK" & Rc).Copy
    With Sheet2
      .Range("3:65") = ""
      .Range("A3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      Union(.Rows("65:65"), .Rows("59:63"), .Rows("55:56"), .Rows("28:29"), .Rows("21:25"), _
        .Rows("19:19"), .Rows("12:15"), .Rows("4:10")).Delete
    End With
End Sub

金樽空对月

详见附件

roseland

金樽空对月 发表于 2022-5-11 22:08
详见附件

为什么我下载下来解压缩后，VBA都没了，是我哪里操作有误嘛？

金樽空对月

roseland 发表于 2022-5-12 09:28
为什么我下载下来解压缩后，VBA都没了，是我哪里操作有误嘛？

1. Sub mytest()
   
2. ar = Sheets("简易打印报表").Range("a3:cx39")
   
3. br = Sheet1.Range("a5:bk106")
   
4. For x = 2 To UBound(ar, 1)
   
5.     For y = 1 To UBound(br, 2)
   
6.         If br(1, y) = ar(x, 1) Then
   
7.             For j = 2 To UBound(br, 1)
   
8.                 If br(j, y) <> "" Then
   
9.                     n = n + 1
   
10.                     ar(x, n + 1) = br(j, y)
    
11.                     ar(1, j) = n
    
12.                 End If
    
13.             Next j
    
14.             n = 0
    
15.         End If
    
16.     Next y
    
17. Next x
    
18. Sheet2.Range("a3").Resize(UBound(ar, 1), UBound(ar, 2)) = ar
    
19. End Sub

复制代码

金樽空对月

roseland 发表于 2022-5-12 09:28
为什么我下载下来解压缩后，VBA都没了，是我哪里操作有误嘛？

你的EXCEL版本是哪个，或者看在打开工作薄时有什么安全提示，又或者是解压后打开错误