返回列表 上一主題 發帖

[發問] [字典物件]列出各工作表特定值問題

greetingsfromtw

帖子
45 
主題
10 
精華
0 
積分
59 
點名
0  
作業系統
Win7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-2-6 
最後登錄
2019-6-22 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-11-1 14:46 | 只看該作者

[發問] [字典物件]列出各工作表特定值問題

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


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

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

20161101-列出各工作表特定值問題.zip (13.12 KB)
  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
複製代碼
收藏 分享

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-23 
2#
發表於 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
　
　

TOP

greetingsfromtw

帖子
45 
主題
10 
精華
0 
積分
59 
點名
0  
作業系統
Win7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-2-6 
最後登錄
2019-6-22 

論壇贊助勳章
3#
發表於 2016-11-1 22:34 | 只看該作者
回復 2# 准提部林

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

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題