返回列表 上一主題 發帖

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

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1447 
主題
40 
精華
0 
積分
1471 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2025-3-24 
1# 跳轉到 »
發表於 2023-5-10 14:51 | 顯示全部帖子
回復 9# 准提部林


    謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案1,方案學習心得註解如下,請前輩再指導

執行前:


執行結果:



Sub ex()
[B2:E200].ClearContents
'↑清除結果欄舊資料
Set d = CreateObject("Scripting.Dictionary")
'↑令d變數是字典
Set Rng = Range("J1").CurrentRegion.SpecialCells(xlCellTypeConstants)
'↑令Rng變數是 [J1]串並聯儲存格擴展範圍的非空白格  ('比對陣列)
For Each a In Range([A2], [A2].End(xlDown))
'↑設逐項迴圈!令a變數是A欄裡的儲存格 ('原始資料迴圈)
  For Each c In Rng
  '↑設逐項迴圈!令c變數是Rng變數裡的儲存格
     If InStr(UCase(a), UCase(c)) > 0 Then
     '↑如果a變數儲存格值轉換成英文大寫的新字串後,
     '裡面有包含 c變數儲存格值轉換成英文大寫的新字串
        d(c.Column) = ""
        '↑令以c變數欄位數當key,item是空字元,納入d字典裡
        '('記住比對到陣列的欄位)
     End If
  Next
  If d.Count > 0 Then
  '↑如果d字典key數量>0 ?('表示原始資料比對成功)
     For Each ky In d.keys
     '↑設逐項迴圈!令ky是d字典裡的一個key
       Cells(65536, ky - 8).End(xlUp).Offset(1, 0) = a
       '↑令結果欄的第一個空白格是 a變數(儲存格值)
     Next
     d.RemoveAll
     '↑清空d字典
     Else
     Cells(65536, "E").End(xlUp).Offset(1, 0) = a
     '↑比對不成功!就將a變數(儲存格值)放在E欄第一個空白格
  End If
Next
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1447 
主題
40 
精華
0 
積分
1471 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2025-3-24 
2#
發表於 2023-5-10 15:42 | 顯示全部帖子
回復 9# 准提部林


    謝謝前輩
後學藉此帖學習前輩方案2(不重複),方案學習心得註解如下,請前輩再指導

執行結果:



Sub U_Test()
Dim xR As Range, xD, Arr, Brr, Mx&, N%, G(1 To 4), DK
'↑宣告變數
[B2:E200].ClearContents
'↑清除結果欄舊資料
Arr = Range([A2], Cells(Rows.Count, 1).End(xlUp))
'↑令Arr變數是二維陣列,以A欄儲存格值(原始資料)帶入陣列裡
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是字典
For Each xR In [J2:L40]
'↑令設逐項迴圈!令xR是範圍儲存格裡的一格
    If xR <> "" Then xD(UCase(xR)) = xR.Column - 9
    '↑如果xR變數不是空的!就令其轉換為大寫英文當key,item是其欄數-9,
    '納入xD字典裡('關鍵字依其欄位帶序號)
Next
ReDim Brr(1 To UBound(Arr), 1 To 4)
'↑宣告Brr變數是二維空陣列,縱向範圍同Arr,橫向從1 到4
For i = 1 To UBound(Arr)
'↑設順迴圈
    N = 4
    '↑令N變數是 4 ('預設序號為4,是用來放不符合的資料)
    For Each DK In xD.keys
    '↑設逐項迴圈!令DK是xD字典裡的一個key
        If InStr(UCase(Arr(i, 1)), DK) Then N = xD(DK): Exit For
        '↑如果原始資料轉換英文大寫的新字串裡有包含DK變數!
        '就令N變數變更為 以DK變數查xD字典的item值('有符合,取出序號),
        '取出序號後就結束迴圈,代表不重複使用 原始資料
    Next
    G(N) = G(N) + 1
    '↑依序號不同, 各自在G這一維陣列裡 累計欄位的筆數
    If G(N) > Mx Then Mx = G(N)
    '↑取得最大筆數
    Brr(G(N), N) = Arr(i, 1)
    '↑按序號及筆數填入資料到陣列
Next i
[B2].Resize(Mx, 4) = Brr
'↑令從[B2]開始擴展有資料的列數4欄,以Brr陣列值帶入
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 【行善要及時】行善要及時，功德要持續。如燒開水一般，未燒開之前千萬不要停熄火候，否則重來就太費事了。
返回列表 上一主題