標題: [發問] Excel VBA sorting 後複製貼上 [打印本頁]

---

作者: tommy.lin    時間: 2012-8-27 13:30     標題: Excel VBA sorting 後複製貼上

想請問板上高手
如附件
我有兩個下拉選單的欄位內容分別為 ABCDEF
ABCDEF 為我的資料頁面Data的表頭.
如果我的下拉選單第一個選了B 第二個選了A
然後執行VB 後VB 會先在 Data 頁面找到B 然後將B欄整欄複製到Result頁面的A欄位去,在做第二次找到A 然後A 複製到Result頁面的B欄位去
不知道VB 的程式應該怎麼寫....感謝板上高手


Regards
:)

---

作者: Hsieh    時間: 2012-8-28 08:48

回復 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

複製代碼

---

作者: tommy.lin    時間: 2012-8-28 10:27

感謝版主....不過程式太精簡@@ 完全不瞭解個步驟做了甚麼....

---

作者: tommy.lin    時間: 2012-9-3 13:50

請教版主有推薦的書? 可以查到有關版主的code

---

作者: Hsieh    時間: 2012-9-3 14:11

回復 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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)