Excel VBA

新用戶6897Uzws 2022-11-23 發布于四川

展開全文

最近寫了一些小功能，對字典有了進一步的理解，太強大了！

個人最近用過的字典應用有這么幾個，寫下來防止自己忘~同時方便大家

一、查找重復行

【原理】利用字典的exist方法，將數據加入字典時判斷一下，如果已經存在，就說明當前數據為重復數據，應該刪除

【示例代碼】

Sub chongfu()         '查重

    Dim i As Long

    Dim endline As Long '定義工作表長度變量

    endline = Sheet3.Range("A30000").End(xlUp).Row '獲取工作表Sheet3有數據的最后一行行號

    Set d = CreateObject("scripting.dictionary")    '設定字典d

    For i = endline To  Step -         '從最后一行開始，依次把各個字段拼接到一起（注意，這里我的需求是這幾個字段拼在一起的字符串不允許重復，因此我先拼接再判重）

        '把所有字符串拼接到數組里

        If Sheet3.Cells(i, ) <> "" Then        '判斷該行是否為空

            If IsError(Sheet3.Cells(i, )) = False Then  '如果關鍵單元格不是#N/A，則進入字典設置

                x = Sheet3.Cells(i, ) '******************設置賦給字典的變量,即需要去重的單元格！*******************

                If Not d.Exists(x) Then     '判斷是否重復

                    d(x) = x             '如果不重復，則把x定為item

                Else

                    Sheet3.Rows(i & ":" & i).Delete Shift:=xlUp        '如果字典中已有對應的item，則該行重復，刪除重復的行

                End If

            End If

        End If

    Next

End Sub

【效果展示】

Excel VBA ——字典實用技巧-LMLPHP

二、查找關鍵字

【原理】最常見的應用，根據key來查找對應的item

【示例代碼】

Sub DicFind()       '查找編號對應的數據

    endline = Sheet3.Range("E100000").End(xlUp).Row '獲取待匹配的數據區域長度

    Set d = CreateObject("Scripting.Dictionary")  '設置字典d

    Arr = Sheet3.Range("A2:B26975")          '獲得字典數據

    For i =  To UBound(Arr)                 '設置sheet3 A列為字典關鍵字key，B列為字典關鍵字對應的值（item）

        If Arr(i, ) <> "" Then              '當A列不為空時，將item裝入數組

            x = Arr(i, )                    '想以哪一列為關鍵字查找結果，就把x設置成哪一列的單元格

            d(x) = Arr(i, )

        Else

            Exit For                         'A列為空時，退出for循環

        End If

    Next

    Brr = Sheet3.Range("$E$2:$F$" & endline)  '將待查找的數據放入數組

    For j =  To UBound(Brr)

        x = Brr(j, )               '將E列的編號設為key

        If d.Exists(x) Then         '如果字典中有對應的item，則將item寫入數組brr

            Brr(j, ) = d(x)        '把查找到的item寫入brr，這里對應F列

        End If

    Next

    Sheet3.Range("$E$2:$F$" & endline) = Brr '將匹配好的數據寫回單元格

End Sub