Question

问题相当简单，但我无法找到解决方案。我想在相当长的Excel工作表中删除每行的重复项

我的代码看起来像这样，但不起作用：

Sub delete()

Dim i As Long, j As Integer
i = 1
j = 2
While Sheets("Test").Cells(i, 1).Value <> "end"
    While Sheets("Test").Cells(i, j).Value <> ""
        If Sheets("Test").Cells(i, j) <> Sheets("Test").Cells(i, j).offset(, 1) Then
            j = j + 1
        Else
            Sheets("Test").Cells(i, j).offset(, 1).Clear
            j = j + 1
        End If
    Wend
i = i + 1
Wend

End Sub

A列底部的

是单词end，要整理的数据在B到QC列中。有些行有重复，有些则没有。在下一步中，我需要收集由逗号分隔的B列中的非重复值。有人可以帮我吗？

图片：

Current datastructure

After deletion of the Duplicates

Answer 1

Sub DeleteRows()

Dim LastRow As Long
Dim LastCol As Long
Dim i As Long
Dim wsTemp As Worksheet
Dim v As Variant

Set wsTemp = ActiveWorkbook.Worksheets.Add

With Sheets("Test")
    LastRow = .Range("A:A").Find(what:="end", after:=.Cells(.Rows.Count, 1), LookIn:=xlValues, lookat:=xlWhole).Row

    For i = 1 To LastRow
        LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
        If LastCol > 1 Then
            v = .Cells(i, 1).Resize(1, LastCol).Value
            .Cells(i, 1).Resize(1, LastCol).ClearContents
            wsTemp.Range("A:A").Clear
            wsTemp.Range("A1").Resize(UBound(v, 2), 1).Value = Application.Transpose(v)
            wsTemp.Range("A1").Resize(UBound(v, 2), 1).RemoveDuplicates Columns:=1, Header:=xlNo
            v = wsTemp.Range("A:A").SpecialCells(xlCellTypeConstants).Value
            .Cells(i, 1).Resize(1, UBound(v, 1)).Value = Application.Transpose(v)
        End If
    Next
End With

Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True

End Sub

VBA从行中删除重复项

1 个答案: