返回列表 上一主題 發帖

[字典物件]單一欄位的值與多個陣列比對後並分類至不同欄位

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
1# 跳轉到 »
發表於 2016-10-20 16:41 | 顯示全部帖子
本帖最後由 准提部林 於 2016-10-20 16:43 編輯
  1. Sub U_Test()
  2. Dim xR As Range, xD, Arr, Brr, Mx&, N%, G(1 To 4), DK
  3. Arr = Range([A2], Cells(Rows.Count, 1).End(xlUp))
  4. Set xD = CreateObject("Scripting.Dictionary")
  5. For Each xR In [J2:L40]
  6.     If xR <> "" Then xD(UCase(xR)) = xR.Column - 9 '關鍵字依其欄位帶序號
  7. Next
  8. ReDim Brr(1 To UBound(Arr), 1 To 4)

  10. For i = 1 To UBound(Arr)
  11.     N = 4 '預設序號為4
  12.     For Each DK In xD.keys
  13.         If InStr(UCase(Arr(i, 1)), DK) Then N = xD(DK): Exit For '有符合,取出序號
  14.     Next
  15.     G(N) = G(N) + 1 '依序號不同, 各自累計欄位的筆數
  16.     If G(N) > Mx Then Mx = G(N) '取得最大筆數
  17.     Brr(G(N), N) = Arr(i, 1) '按序號及筆數填入資料到陣列
  18. Next i
  19. [B2].Resize(Mx, 4) = Brr
  20. End Sub
複製代碼


InStr 會區分英文大小寫, 必須使用 UCase 統一轉為大寫(LCase也可)

TOP

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
2#
發表於 2016-10-21 15:49 | 顯示全部帖子
回復 8# greetingsfromtw


１．能贊助即可貴，這也幫助他人可以在此獲得知識
２．４樓超板的方法也許較符實情（以篩選而言），同一文字包含兩個關鍵字時，則兩次分別取出，
　　可測試範例檔的兩個程式去比較
３．另提供一個方便針對選取單一關鍵字的篩選法

20161020_比對單行資料與多個陣列v01.rar (14.18 KB)
　
　

TOP

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
3#
發表於 2016-10-21 19:50 | 顯示全部帖子
本帖最後由 准提部林 於 2016-10-21 19:53 編輯

回復 10# greetingsfromtw


那是工作表〔事件〕觸發程式，按Alt + F11，對工作表物件按兩下

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim xR As Range
With Target
　　If Intersect([J2:L8], .Cells) Is Nothing Then Exit Sub
　　If .Value = "" Then Exit Sub
　　Cancel = True
　　For Each xR In Range([A2], Cells(Rows.Count, 1).End(xlUp))
　　　　If InStr(UCase(xR), UCase(.Value)) > 0 Then
　　　　　Cells(Rows.Count, "G").End(xlUp)(2) = xR
　　　　End If
　　Next
End With
End Sub

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
返回列表 上一主題