Question

必须删除C列中的所有重复项，具体取决于B列中的特定范围.Column C在下一个值之前有两个连续的行和两个或多个空白单元格，第一个值是文本描述的文本和紧接其下方的行具有相应的编号（一般（6位数））。根据文档描述和文档编号，删除所有重复项。如果文档描述相同但文档编号系列不同，如第一个文档系列是654321删除所有65xxxx系列但保留除了6xxxxx以外的任何东西。有以下代码行从列B获取范围并清除仅用于文档描述的内容。但我不确定哪里犯了错误。想要开始使用文档描述，然后添加代码来检查文档编号。但我无法排序第一步。这段代码是完整代码的一个块... 任何协助或坚定的推动正确的方向将非常感激......

Do Until Range("B" & lngLastRow + 10).Value = "" 
  x = 2 
  y = x 

  Do 
    x = x + 1 
  Loop Until Range("B" & x).Value <> "" 

  For i = x To y Step -1 
    If Application.WorksheetFunction.CountIf(Range(Cells(y, "C"), Cells(i, "C")), Range("C" & i).Text) > 1 Then 
        Range("C" & i).Select 
        Selection.ClearContents 
    End If 
  Next i 

  y = y + x 
Loop

Answer 1

重读几次后，这是我从你的问题中理解的。假设您的工作表看起来像这样

enter image description here

现在，如果Description重复，则要清除Number和Description的内容，并且该数字与第一个开头的系列具有相同的系列。< / p>

如果我的理解是正确的，那么试试这个

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim aCell As Range, bCell As Range, ClearRng As Range
    Dim SearchString As String
    Dim n As Long

    '~~> Change this to the releavnt worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    '~~> Searching for this description. You can pick this
    '~~> Value from Col B
    SearchString = "Desp1"

    With ws
        '~~> Search Col C for the first match
        Set aCell = .Columns(3).Find(What:=SearchString, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        '~~> If found
        If Not aCell Is Nothing Then
            Set bCell = aCell
            '~~> Get the first two numbers to identify the series
            n = Left(aCell.Offset(1).Value, 2)

            '~~> Store the cells ina range
            Set ClearRng = Union(aCell, aCell.Offset(1))

            '~~> Find Next
            Do
                Set aCell = .Columns(3).FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do
                    '~~> Check for series
                    If Left(aCell.Offset(1).Value, 2) = n Then
                        '~~> Store the cells ina range
                        Set ClearRng = Union(ClearRng, aCell, aCell.Offset(1))
                    End If
                Else
                    Exit Do
                End If
            Loop
        End If

        '~~> I am coloring the range red. You can use ClearRng.Clearcontents
        If Not ClearRng Is Nothing Then ClearRng.Interior.ColorIndex = 3
    End With
End Sub

<强>输出

enter image description here

来自工作表函数Countif的意外结果

1 个答案: