把表1工作表中指定列的数据，复制到表2工作表，对应的标题行下！

2217918

把表1工作表中指定列的数据，复制到表2工作表，对应的标题行下，请各位老师帮忙下，谢谢！


工作表都是从系统里面导出来的，每一次不一样，希望用VBA完成!

Excel_muke

用公式的话，这样符不符合你的需求

1. D7   {=INDIRECT("表1!V"&SMALL(IF(表1!$V$11:$V$18<>"",ROW(表1!$V$11:$V$18),""),ROW(A1)))}

复制代码

2217918

Excel_muke 发表于 2024-8-28 17:04
用公式的话，这样符不符合你的需求

收到，谢谢！工作表都是从系统里面导出来的，每一次不一样，希望用VBA完成!

ykcbf1100

用VBA写了一个

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.28
   
2.     Application.ScreenUpdating = False
   
3.     With Sheets("表1")
   
4.         r = .UsedRange.Find("*", , -4163, , 1, 2).Row
   
5.         c = .Cells.SpecialCells(11).Column
   
6.         arr = .[a1].Resize(r, c)
   
7.         ReDim brr(1 To r, 1 To 3)
   
8.         For i = 11 To UBound(arr)
   
9.             If InStr(arr(i, 3), "-") Then
   
10.                 m = m + 1
    
11.                 brr(m, 1) = arr(i, 22)
    
12.                 brr(m, 2) = arr(i, 27)
    
13.                 brr(m, 3) = arr(i, 41)
    
14.             End If
    
15.         Next
    
16.     End With
    
17.     With Sheets("表2")
    
18.         .[d7].Resize(m, 1) = Application.Index(brr, 0, 1)
    
19.         .[f7].Resize(m, 1) = Application.Index(brr, 0, 2)
    
20.         .[h7].Resize(m, 1) = Application.Index(brr, 0, 3)
    
21.     End With
    
22.     Application.ScreenUpdating = True
    
23.     MsgBox "OK！"
    
24. End Sub
    
25. 
    

复制代码

2217918

ykcbf1100 发表于 2024-8-28 20:38
参与一下。。。

谢谢老师，非常感谢！