麻烦用VBA从一个表按照表头提取到另一个表格

ping200030

bqwd36

感觉你这个直接用公式函数啥的就可以吧

3190496160

那就用字段呗，先把目标表的表头赋值给字典并记录列号，然后循环数据源

于箱长

3190496160 发表于 2023-3-8 13:18
那就用字段呗，先把目标表的表头赋值给字典并记录列号，然后循环数据源

好思路

洋务德雷

用SQL解决的。不用vba也可以

ykcbf1100

附件请参考。。。

全党

ykcbf1100 发表于 2023-3-8 15:16
附件请参考。。。

老师，您写的这段程序，有个问题，就是标题不按照顺序排列的时候引用不对，我改了一下，看看怎样再优化一下，刚学，多多指教。

1. Sub shishi()
   
2.     Dim arr, brr(1 To 9999, 1 To 100), d
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheet1
   
5.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
6.         c = .Cells(2, Columns.Count).End(xlToLeft).Column
   
7.         arr = .[a1].Resize(r, c)
   
8.         crr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(.[a2].Resize(1, c)))
   
9.         End With
   
10.        With Sheet2
    
11.         c = .Cells(3, Columns.Count).End(xlToLeft).Column
    
12.             For i = 1 To c
    
13.              d(.Cells(3, i).Value) = .Cells(3, i).Offset(-1, 0).Value
    
14.             Next
    
15.        End With
    
16.   k = d.items
    
17.   For j = 0 To d.Count - 1
    
18.      If k(j) = "" Then
    
19.         For l = 1 To r - 1
    
20.            brr(j + 1, l) = ""
    
21.         Next l
    
22.      ElseIf k(j) <> "" Then
    
23.         kk = WorksheetFunction.Match(k(j), crr, 0)
    
24.         For l = 2 To r - 1
    
25.            brr(j + 1, l - 1) = arr(l + 1, kk)
    
26.         Next l
    
27.       End If
    
28.   Next
    
29.     Sheet2.UsedRange.Offset(3) = ""
    
30.     Sheet2.Range("a4").Resize(r - 2, c) = WorksheetFunction.Transpose(brr)
    
31.    
    
32. End Sub
    

复制代码

jjmysjg

按字段提取数据