时间戳

首页 > 解决方案 > 删除表格范围外的一个重复单元格

vba - 删除表格范围外的一个重复单元格

问题描述

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

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

  1. ABCDE
  2. 一个
  3. 英国广播公司
  4. cbcef
  5. ddefgh

这就是我要的：

  1. ABCDE
  2. 一个
  3. 英国广播公司
  4. 参考
  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

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

标签： vbaexcel

解决方案

尝试这个：

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

推荐阅读