Remove duplicates from array using VBA

前端 未结 8 823
猫巷女王i
猫巷女王i 2020-11-27 22:12

Assume I have a block of data in Excel 2010, 100 rows by 3 columns.

Column C contains some duplicates, say it starts off as

1, 1, 1, 2, 3, 4,

8条回答
  •  独厮守ぢ
    2020-11-27 23:11

    I know this is old, but here's something I used to copy duplicate values to another range so that I could see them quickly to establish data integrity for a database I was standing up from various spreadsheets. To make the procedure delete the duplicates it would be as simple as replacing the dupRng lines with Cell.Delete Shift:=xlToLeft or something to that effect.

    I haven't tested that personally, but it should work.

    Sub PartCompare()
        Dim partRng As Range, partArr() As Variant, i As Integer
        Dim Cell As Range, lrow As Integer
    
        lrow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        i = 0
    
        Set partRng = ThisWorkbook.Worksheets("Sheet1").Range(Cells(1, 1), Cells(lrow, 1))
    
        For Each Cell In partRng.Cells
            ReDim Preserve partArr(i)
            partArr(i) = Cell.Value
            i = i + 1
        Next
    
        Dim dupRng As Range, j As Integer, x As Integer, c As Integer
    
        Set dupRng = ThisWorkbook.Worksheets("Sheet1").Range("D1")
    
        x = 0
        c = 1
        For Each Cell In partRng.Cells
            For j = c To UBound(partArr)
                If partArr(j) = Cell.Value Then
                    dupRng.Offset(x, 0).Value = Cell.Value
                    dupRng.Offset(x, 1).Value = Cell.Address()
                    x = x + 1
                    Exit For
                End If
            Next j
            c = c + 1
        Next Cell
    End Sub
    

提交回复
热议问题