从数组中删除重复 – vba

我有一个代码，从一个文件的列抓取数据，并将其放入一个数组。

现在，我想通过这个数组并删除重复，但我不能通过…任何想法？

这是代码，数组在最后：

Dim i As Long Dim searchItem As Variant strSearch = "" searchItem = "" strFile = "...\Desktop\xl files min\src.xlsm" Set s_wbk = Workbooks.Open(strFile) With s_wbk.Worksheets("Sheet1") For i = 1 To Rows.Count If Not IsEmpty(Cells(i, 1).Value) Then strSearch = strSearch & "," & Cells(i, 1).Value End If Next i End With s_wbk.Close searchItem = Split(strSearch, ",") '*NEED TO REMOVE DUPLICATES 

Answer 1

通过使用InStr函数testing以前存在的string构造过程中删除重复项。

  If Not IsEmpty(Cells(i, 1).Value) And _ Not InStr(1, strSearch, Cells(i, 1).Value & ",", vbTextCompare) Then strSearch = strSearch & "," & Cells(i, 1).Value End If 

在拆分之前，还应该删除最后一个尾部的逗号。

 Next i strSearch = Left(strSearch, Len(strSearch) - 1) 

最后，如果你已经将值添加到一个Scripting.Dictionary对象中（它有自己唯一的主键索引），那么你就可以在已经为你创build的数组中有一组唯一的键值。

Answer 2

最简单的方法是复制你从你的input，并使用内置函数来摆脱重复的工作表，看看这个：

 Dim i As Long Dim searchItem As Variant Dim Ws As Worksheet strSearch = "" searchItem = "" strFile = "...\Desktop\xl files min\src.xlsm" Set s_wbk = Workbooks.Open(strFile) 'Copy the sheet s_wbk.Sheets("Sheet1").Copy (s_wbk.Sheets(1)) Set Ws = s_wbk.Sheets(1) With Ws 'Remove duplicates from column A With .Range("A:A") .Value = .Value .RemoveDuplicates _ Columns:=Array(1), _ Header:=xlNo End With For i = 1 To .Range("A" & .Rows.count).End(xlUp).Row If Not IsEmpty(.Cells(i, 1)) Then strSearch = strSearch & "," & .Cells(i, 1).Value End If Next i 'Get rid of that new sheet Application.DisplayAlerts = False .Delete Application.DisplayAlerts = False End With s_wbk.Close searchItem = Split(strSearch, ",") 'NO MORE DUPLICATES ;) 

甚至更快 （因为在RemoveDuplicates之后，范围内没有空单元格）：

 Dim i As Long Dim searchItem As Variant Dim Ws As Worksheet strSearch = "" searchItem = "" strFile = "...\Desktop\xl files min\src.xlsm" Set s_wbk = Workbooks.Open(strFile) 'Copy the sheet s_wbk.Sheets("Sheet1").Copy (s_wbk.Sheets(1)) Set Ws = s_wbk.Sheets(1) With Ws 'Remove duplicates from column A With .Range("A:A") .Value = .Value .RemoveDuplicates _ Columns:=Array(1), _ Header:=xlNo End With 'NO MORE DUPLICATES and FASTER ARRAY FILL ;) searchItem = .Range(.Range("A1"), .Range("A" & .Rows.count).End(xlUp)).Value 'Get rid of that new sheet Application.DisplayAlerts = False .Delete Application.DisplayAlerts = False End With s_wbk.Close 

Answer 3

这对我工作：

 Function removeDuplicates(ByVal myArray As Variant) As Variant Dim d As Object Dim v As Variant 'Value for function Dim outputArray() As Variant Dim i As Integer Set d = CreateObject("Scripting.Dictionary") For i = LBound(myArray) To UBound(myArray) d(myArray(i)) = 1 Next i i = 0 For Each v In d.Keys() ReDim Preserve outputArray(0 To i) outputArray(i) = v i = i + 1 Next v removeDuplicates = outputArray End Function 

希望能帮助到你

Answer 4

通常我使用字典对象来检查重复项，或者使用它自己。 字典是引用唯一键值的对象。 由于密钥必须是唯一的，因此可以用来收集唯一的值。 也许这不是最有效的内存方式和probaby有点瑕疵的对象，但它工作得很好。 你必须调暗一个对象，并将其设置为一个字典，收集数据，检查后，它不存在，然后通过字典循环收集的价值。

 Dim i As Long Dim searchItem As Variant, var as variant dim dicUniques as object set dicUniques = CreateObject("Scripting.Dictionary") strSearch = "" searchItem = "" strFile = "...\Desktop\xl files min\src.xlsm" Set s_wbk = Workbooks.Open(strFile) With s_wbk.Worksheets("Sheet1") For i = 1 To Rows.Count If Not IsEmpty(Cells(i, 1).Value) Then if dicUniques.exists(cells(i,1).value) = false then dicUniques.add cells(i,1).value, cells(i,1).value end if End If Next i End With s_wbk.Close for each var in dicUniques.keys strSearch = strSearch & ", " & var next var searchItem = Split(strSearch, ",") 

这是快速和肮脏的解决scheme。 由于键是独一无二的，你可以自己使用它们，而不必先把它们放在一起。 顺便说一句：首先，你应该指定你使用的单元格。 有时，如果没有为单元格对象提供父工作表，则会从另一个工作表的macros开始，然后使用其中的单元格。 其次，指定要使用字典的单元格值很重要，因为字典对象可以包含任何内容。 所以如果你不使用单元格（x，y）.value，对象将包含单元格本身。

编辑：在例程中更正了错字。