VBA,从数组中删除重复项

Yht*_*t H 7 excel vba

有人可以给我一些指示如何解决以下问题:

假设我在Excel 2010中有一个数据块,100行乘3列.

C列包含一些重复项,比如它从1,1,1 2,3,4,5,.....,97,98开始

使用VBA,我想删除duplcate行,根据列C,以便我留下1,2,3,.....,97,98,即只有98行和3列.

我知道有一个按钮我可以在Excel 2010中单击以执行此操作,但我想在VBA中执行此操作(因为我已经尝试过这个并且由于某种原因,随后会对我的其余代码进行干扰并给出不正确的结果).

此外,我想在数组中执行此操作,然后将结果粘贴到工作表上,而不是像Application.Worksheetfunction.countif(.....)这样的方法.

所以类似于:

Dim myarray() as Variant
myarray=cells(1,1).Currentregion.value

Dim a as Long

For a=1 to Ubound(myarray,1)

    'something here to 

Next a
Run Code Online (Sandbox Code Playgroud)

Zai*_*rja 6

我回答了类似的问题.这是我使用的代码:

Dim dict As Object
Dim rowCount As Long
Dim strVal As String

Set dict = CreateObject("Scripting.Dictionary")

rowCount = Sheet1.Range("A1").CurrentRegion.Rows.Count

'you can change the loop condition to iterate through the array rows instead
Do While rowCount > 1
  strVal = Sheet1.Cells(rowCount, 1).Value2

  If dict.exists(strVal) Then
    Sheet1.Rows(rowCount).EntireRow.Delete
  Else
    'if doing this with an array, then add code in the Else block
    ' to assign values from this row to the array of unique values
    dict.Add strVal, 0
  End If

  rowCount = rowCount - 1
Loop

Set dict = Nothing
Run Code Online (Sandbox Code Playgroud)

如果要使用数组,则使用相同的条件(if/else)语句遍历元素.如果字典中不存在该项,则可以将其添加到字典中并将行值添加到另一个数组中.

老实说,我认为最有效的方法是调整你从宏录制器获得的代码.您可以在一行中执行上述功能:

    Sheet1.UsedRange.RemoveDuplicates Columns:=3, Header:=xlYes
Run Code Online (Sandbox Code Playgroud)

  • 这会删除工作表中的实际行,而问题是删除VBA中的重复项.此外,任何行删除都应始终从下往上进行,以避免跳过行 (3认同)

小智 6

Function eliminateDuplicate(poArr As Variant) As Variant
    Dim poArrNoDup()

    dupArrIndex = -1
    For i = LBound(poArr) To UBound(poArr)
        dupBool = False

        For j = LBound(poArr) To i
            If poArr(i) = poArr(j) And Not i = j Then
                dupBool = True
            End If
        Next j

        If dupBool = False Then
            dupArrIndex = dupArrIndex + 1
            ReDim Preserve poArrNoDup(dupArrIndex)
            poArrNoDup(dupArrIndex) = poArr(i)
        End If
    Next i

    eliminateDuplicate = poArrNoDup
End Function
Run Code Online (Sandbox Code Playgroud)


San*_*arn 5

从一维数组中删除重复项的简单函数

Private Function DeDupeArray(vArray As Variant) As Variant
  Dim oDict As Object, i As Long
  Set oDict = CreateObject("Scripting.Dictionary")
  For i = LBound(vArray) To UBound(vArray)
    oDict(vArray(i)) = True
  Next
  DeDupeArray = oDict.keys()
End Function
Run Code Online (Sandbox Code Playgroud)

编辑:

使用stdVBA(一个主要由我维护的库),您可以使用:

uniqueValues = stdEnumerator.CreateFromArray(myArray).Unique().AsArray()
Run Code Online (Sandbox Code Playgroud)