Sub 去重復(fù)項(xiàng)()

   Dim i As Long, m As Long, k As Long

   Dim Str As String

   Dim dic As Object

   Dim Arr

   'A列非空行數(shù)，賦值給m

   m = Worksheets('Sheet1').Cells(Rows.Count, 1).End(xlUp).Row

   '字典

   Set dic = CreateObject('scripting.dictionary')

   '將數(shù)據(jù)裝入數(shù)組Arr

   Arr = Range('A3:A' & m)

   For i = 3 To UBound(Arr, 1)

       '將數(shù)據(jù)轉(zhuǎn)換成字符串類(lèi)型

       Str = Arr(i, 1)

       '如果字典中不存在Str，則

       If Not dic.exists(Str) Then

           '將Str作為關(guān)鍵字裝入字典

           dic(Str) = ''

       End If

   Next

   '清空C列內(nèi)容

   [C:C].ClearContents

   '以C3單元格為起始，調(diào)整數(shù)據(jù)寫(xiě)入?yún)^(qū)域，寫(xiě)入?yún)^(qū)域行數(shù)為dic.Count數(shù)目

   '將字典關(guān)鍵字轉(zhuǎn)置后寫(xiě)入?yún)^(qū)域

   Range('C3').Resize(dic.Count, 1).Value = Application.Transpose(dic.keys)

   '清空字典

   Set dic = Nothing

End Sub