从表格范围

Question

我想从特定的表格范围中删除重复的单元格，但不应删除一个副本（从顶部开始的第一个）。不应搜索表的A列是否有重复项。从B列开始，表中也没有内容。

这就是它的外观（对不起编号，不知道如何格式化它）：

1. ABCDE
2. 一个
3. bbcde
4. cbcef
5. ddefgh

这就是我想要的：

1. ABCDE
2. 一个
3. bbcde
4. CF
5. DGH

我尝试用两个for循环来做这个。第一个循环遍历每一行，第二个循环遍历每一列。如果找到重复，则应删除它。

但是我想我已经把for循环搞砸了，因为有时它会删除一些奇怪的东西而不是重复的东西..

Dim reportsheet As Worksheet
Dim C1row As Long
Dim C2row As Long
Dim C2column As Long
Dim C2TotalRows As Long
Dim CustID As String
Dim NoDups As Long

Set reportsheet = ThisWorkbook.Worksheets("Tabelle44")
reportsheet.Activate
Sucher_rowTotalRows = Application.CountA(Range("A:A")) ' switchen durch Reihen
Duplikat_row = 1 'für aeuseres For zum durchswitschen zwischen den Ist
Sucher_row = 1
Duplikat_column = 2
Sucher_column = 2

testwert = Cells(Duplikat_row, Columns.Count).End(xlToLeft).Column

Do While Duplikat_row <= Sucher_rowTotalRows

    If Cells(Duplikat_row, Columns.Count).End(xlToLeft).Column = 1 Then
    Duplikat_row = Duplikat_row + 1
    Sucher_row = Sucher_row + 1
    End If

    duplikat = reportsheet.Cells(Duplikat_row, Duplikat_column).Value

     For Sucher_row = 1 To Sucher_rowTotalRows
        For Sucher_column = 2 To (Cells(Sucher_row, Columns.Count).End(xlToLeft).Column) '' Breite der Spalte
            If duplikat = Cells(Sucher_row, Sucher_column).Value Then '' Falls gesuchtes und gesuchert uebereinstimmt

                Cells(Sucher_row, Sucher_column).Delete xlShiftToLeft '' löschen und nach links verschieben
                Sucher_column = Sucher_column - 1
                Exit For
            End If
        Next
        Sucher_column = Sucher_column + 1 '' Suchspalte eins weiter
    Next
    Duplikat_row = Duplikat_row + 1 ''suchreihe eins weiter
Loop

知道那里出了什么问题吗？非常感谢！

Answer 1

试试这个：

duplikat = reportsheet.Cells(Duplikat_row, Duplikat_column).Value

For Sucher_row = 1 To Sucher_rowTotalRows
    For Sucher_column = 2 To (Cells(Sucher_row, Columns.Count).End(xlToLeft).Column) '' Breite der Spalte
        Do While duplikat = Cells(Sucher_row, Sucher_column).Value  '' Falls gesuchtes und gesuchert uebereinstimmt
            If Sucher_row = Duplikat_row And Sucher_column = Duplikat_column Then
                Exit Do
            Else
                Cells(Sucher_row, Sucher_column).Delete xlShiftToLeft '' löschen und nach links verschieben
            End If
        Loop
    Next
Next