各位前輩好,
小弟目前在練習時遇到一個問題,
簡述問題如下:
假設有一活頁簿,共有4個工作表,3個含有資料,第4個做為顯示結果用,
(其實當然是希望不只3個,但目前僅做為練習用,故先假定3個)
前3個工作表內均有3欄,
第1欄為編號,第2欄為名稱,第3欄為數據.
希望可以將3個工作表內第2欄名稱為"A"的數據找出,刪除重複數據並貼至第4個工作表,第1欄則重新編號.
小弟有試著修改前輩的程式碼,但結果不甚理想,不知問題出在哪裡,
斗膽上來發問,還望前輩不吝指點迷津,十分感謝.
附上檔案及程式碼以供前輩參考:
註:"希望結果"分頁的A-C欄是所期望的運行結果,
但目前程式實際運行的結果會顯示在"希望結果"分頁的F至H欄.
 20161101-列出各工作表特定值問題.zip (13.12 KB)
- '此為參考板上前輩程式碼進行修改,非我原創
- '論壇網址:http://forum.twbts.com/
- Public Sub test()
- Dim arr(), brr(), myD, mNum
- Set myD = CreateObject("scripting.dictionary")
- ReDim brr(1 To 65536, 1 To 3)
- Sheets(1).Activate
- For Each sht In Sheets
- arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row)
- If sht.Name <> "希望結果" Then
- sht.Activate
- n = n + 1
- For i = 1 To UBound(arr)
- T = arr(i, 3)
- If myD(T) = 1 Then GoTo 101
- If arr(i, 2) <> "A" Then GoTo 101
- For j = 2 To 3
- brr(n, 1) = n
- brr(i, j) = arr(i, j)
- Next j
- myD(T) = 1
- 101:
- Next i
- End If
- Next sht
- Sheets(4).Activate
- If n > 0 Then [f2].Resize(n, 3) = brr
- End Sub
|
發表於 2016-11-1 14:46
| 
