Board logo

標題: [發問] [字典物件]列出各工作表特定值問題 [打印本頁]
作者: greetingsfromtw    時間: 2016-11-1 14:46     標題: [字典物件]列出各工作表特定值問題

各位前輩好,
小弟目前在練習時遇到一個問題,
簡述問題如下:
假設有一活頁簿,共有4個工作表,3個含有資料,第4個做為顯示結果用,
(其實當然是希望不只3個,但目前僅做為練習用,故先假定3個)
前3個工作表內均有3欄,
第1欄為編號,第2欄為名稱,第3欄為數據.
希望可以將3個工作表內第2欄名稱為"A"的數據找出,刪除重複數據並貼至第4個工作表,第1欄則重新編號.
小弟有試著修改前輩的程式碼,但結果不甚理想,不知問題出在哪裡,
斗膽上來發問,還望前輩不吝指點迷津,十分感謝.


附上檔案及程式碼以供前輩參考:

註:"希望結果"分頁的A-C欄是所期望的運行結果,
但目前程式實際運行的結果會顯示在"希望結果"分頁的F至H欄.

[attach]25706[/attach]
  1. '此為參考板上前輩程式碼進行修改,非我原創
  2. '論壇網址:http://forum.twbts.com/
  3. Public Sub test()
  4. Dim arr(), brr(), myD, mNum

  6. Set myD = CreateObject("scripting.dictionary")

  8. ReDim brr(1 To 65536, 1 To 3)
  9. Sheets(1).Activate
  10. For Each sht In Sheets

  12. arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row)

  14. If sht.Name <> "希望結果" Then

  16. sht.Activate

  18. n = n + 1

  20. For i = 1 To UBound(arr)

  22. T = arr(i, 3)

  24. If myD(T) = 1 Then GoTo 101

  26. If arr(i, 2) <> "A" Then GoTo 101

  28. For j = 2 To 3

  30. brr(n, 1) = n
  31. brr(i, j) = arr(i, j)

  33. Next j

  35. myD(T) = 1

  37. 101:

  39. Next i
  40. End If

  42. Next sht

  44. Sheets(4).Activate

  46. If n > 0 Then [f2].Resize(n, 3) = brr

  48. End Sub
複製代碼
作者: 准提部林    時間: 2016-11-1 19:52

Public Sub test()
Dim Arr, Brr, myD, T$, N&, Sht As Worksheet
Set myD = CreateObject("scripting.dictionary")
ReDim Brr(1 To 65536, 1 To 3)
For Each Sht In Sheets
　　If Sht.Name <> "希望結果" Then
　　　　Arr = Sht.Range("a1:c" & Sht.Cells(Rows.Count, 1).End(xlUp).Row)
　　　　For i = 2 To UBound(Arr)
　　　　　　If Arr(i, 2) <> "A" Then GoTo 101
　　　　　　T = Arr(i, 3): If myD(T) = 1 Then GoTo 101
　　　　　　N = N + 1
　　　　　　Brr(N, 1) = N
　　　　　　For j = 2 To 3:  Brr(N, j) = Arr(i, j): Next j
　　　　　　myD(T) = 1
101: Next i
　　　End If
Next Sht
Sheets("希望結果").Activate
If N > 0 Then [f2].Resize(N, 3) = Brr
End Sub
　
　
作者: greetingsfromtw    時間: 2016-11-1 22:34

回復 2# 准提部林

非常感謝淮提部林前輩的指正,
小弟十分慚愧,覺得自己進展太慢了,還得努力學習.
再次感謝前輩無私指點.



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