VBA 只删除一个重复值

Question

第一次发帖，请耐心等待。:)

我正在尝试找到一种方法来比较 Sheet“TransferUt”单元格 A1 中的值与 sheet“Inne”中的范围 A，我只想清除第一个的内容每次我运行宏出现在单元格 A 和 B（Sheet“Inne”）中。问题是，“Inne”中会有许多重复值和单个值。没关系。

我找到并编辑了以下代码（只有我有问题的那一点），但是当我运行它时，它删除了 所有重复的值 “Inne”，A 列，与 Sheet“TransferUt”中的单元格 A1 匹配，我当时只想删除一个。

Dim LastRowInRange  As Long, RowCounter As Long
LastRowInRange = Sheets("Inne").Range("A:A").Find("*", , xlFormulas, , xlByRows, xlPrevious).Row

For RowCounter = LastRowInRange To 1 Step -1
    If Sheets("Inne").Range("A" & RowCounter) = Sheets("TransferUt").Range("A1") Then
        Sheets("Inne").Rows(RowCounter).Cells(2).ClearContents
        Sheets("Inne").Rows(RowCounter).Cells(1).ClearContents
End If
Next

Answer 1

我用这段代码让它工作：

Sub Remove_Duplicates()
Dim C As Range
Dim Endr As Range
Dim Fullr As Range
Set Endr = Range("A1").End(xlDown)
Set Fullr = Range("A1", Endr)

For Each C In Fullr:
  If WorksheetFunction.CountIf(Fullr, C.Value) > 1 Then
     C.ClearContents
  End If
Next

End Sub

因此，如您所见：

Endr 是包含值的“A”列的最后一个单元格。
Fullr 是包含值的“A”列的整个范围。

你运行在整个 Fullr 和每个单元格中，计算它的值出现在“A”列中的次数，当它出现多次时，该值得到删除。这样，CountIf()的值就会减少，直到只剩下一个值。

Answer 2

Sub test()
Dim ThisRow As Long

With Application.WorksheetFunction
    'first, check if value from TransferUt.A1 exist in Inne column A
    If .CountIf(ThisWorkbook.Worksheets("Inne").Range("A:A"), ThisWorkbook.Worksheets("TransferUt").Range("A1")) > 1 Then
        'If it exists then clear only the first occurrence
        ThisRow = .Match(ThisWorkbook.Worksheets("TransferUt").Range("A1"), ThisWorkbook.Worksheets("Inne").Range("A:A"), 0)
        ThisWorkbook.Worksheets("Inne").Range("A" & ThisRow & ":B" & ThisRow).ClearContents 'delete cell contents
    End If
End With

End Sub

代码首先会检查您的目标值是否在 Inne 中存在重复并进行计数。如果计数为 0 或 1，则表示它不存在或它是单个值（A 列中没有重复值）。如果计数大于1，则清空Inne

中A、B单元格的内容

请注意，清除内容不会删除该行，它只会将两个单元格留空。

VBA 只删除一个重复值

VBA Remove only one duplicate value

excel

vba