Hsieh

回復 1# tommy.lin

1. Sub ex()
   
2. With Sheets("Sheet1")
   
3. If Application.CountA(.[B:B]) = 0 Then Exit Sub
   
4.    For Each a In .Range("B:B").SpecialCells(xlCellTypeConstants)
   
5.       With Sheets("Data")
   
6.       Set c = .Rows(1).Find(a, lookat:=xlWhole)
   
7.       k = IIf(Sheets("result").Cells(1, .Columns.Count).End(xlToLeft) = "", 0, 1)
   
8.       Range(c, c.End(xlDown)).Copy Sheets("result").Cells(1, .Columns.Count).End(xlToLeft).Offset(, k)
   
9.       End With
   
10.    Next
    
11. End With
    
12. End Sub

複製代碼

Hsieh

回復 4# tommy.lin
不懂的地方按F1看說明是最好的書籍   
Sub ex()
With Sheets("Sheet1")
If Application.CountA(.[B:B]) = 0 Then Exit Sub  'B欄無資料就跳出程序
   For Each a In .Range("B:B").SpecialCells(xlCellTypeConstants)  '循環每個B欄的資料
      With Sheets("Data")
      Set c = .Rows(1).Find(a, lookat:=xlWhole)  '在Sheets("Data")第一列找尋
      k = IIf(Sheets("result").Cells(1, .Columns.Count).End(xlToLeft) = "", 0, 1)  '假如要複製的目標位置在Sheets("result")的A欄，位移量為0
      Range(c, c.End(xlDown)).Copy Sheets("result").Cells(1, .Columns.Count).End(xlToLeft).Offset(, k) '複製資料
      End With
   Next
End With
End Sub