Question

我一直在尝试比较两个具有多个条件的列。

在列'A'中，存在一个两位数的值，这会导致列'B'中的七位数值，依此类推，只要列'A'有两位数。
在“A”列中，存在一个三位数的值，这会导致列'B'中的八位数值，以及“B”列有三位数的位置。
第4行和第5行是空白。（行的编号和位置可以是任何地方）。
B7和B8是空白的（这也可以是'B'列中的任何位置）。
A12是空白的（这也可以在Column'A'中的任何位置）。
B11有零，但A11有价值（位置不固定，可以在任何地方），如果只是传递价值（可能是没有问题的情况）。

现在使用上述所有Criterion，以下宏必须执行。

我想验证'B2'和'B3'是否以45和57 Resp开头，如'A2'和'A3'中所示，并且有七位数。

'B7'和'B8'以234和567 Resp开头，如'B7'和'B8'所示，有八位数。

如果整行为空（如第4行和第5行），则删除整行。

如果列'A'中的任何单元格具有值且后续单元格为空（如B9和B10中所示），则必须显示msgbox“列'B'必须经过审核”

如果“B”列中的任何单元格具有值且前面的单元格为空（如A12中所示），则必须显示msgbox“列'A'必须经过审核”

这是图像： -

毕竟，如果未满足任何条件，请显示msgbox“以下行有问题...”

我面临的问题是： - 1.如在Row11中，单元格'B11'为零，所以如果我运行代码，则认为这是错误，不应该是这种情况。 2.对于B9和B10，因为它们是空白的，它没有显示任何错误但它应该是3.而对于A12也是空白但B12有值它必须显示错误

我已经编写或收集了这段代码： -

Sub Comparing()
    Range("A:B").Select

    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    ActiveSheet.Range("B:B").EntireColumn.AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd

    ActiveSheet.Range("B:B").EntireColumn.AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd

    Dim rng As Range, cell As Range
    Dim strA As String, strB As String, str As String
    Dim NotMatched As Boolean

    lr = Cells(Rows.Count, 1).End(xlUp).Row

    Set rng = Range("B2:B" & lr)
    str = "The following cells don't match." & vbNewLine & vbNewLine

    For Each cell In rng
        If cell <> "" Then
            n = Len(cell.Offset(0, -1))

            If n > 0 Then
                strA = cell.Offset(0, -1).Text
                strB = Left(cell, n)

                If strA <> strB Then
                    NotMatched = True
                    str = str & cell.Offset(0, -1).Address(0, 0) & " : " & cell.Offset(0, -1).Value & vbTab & cell.Address(0, 0) & " : " & cell.Value & vbNewLine
                End If

            Else
                str = str & cell.Offset(0, -1).Address(0, 0) & " : " & cell.Offset(0, -1).Value & vbTab & cell.Address(0, 0) & " : " & cell.Value & vbNewLine
            End If

        End If

        n = 0
        strA = ""
        strB = ""

    Next cell

    If NotMatched Then
        MsgBox str, vbInformation
        Exit Sub
    Else
    End If

End Sub

Answer 1

此代码行将删除行中任一单元格为空白的所有行

Range("A:B").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

我没有添加AutoFilter，因为它不是问题的一部分。为了简化我明确定义cellA和cellB的逻辑，我还定义了一个触发要添加的消息的标志，如果没有满足任何条件。

Sub Comparing_Refactored()
    Application.ScreenUpdating = False
    Dim cellA As Range, cellB As Range
    Dim x As Long

    Dim bFlag As Boolean
    Dim msg As String

    With ActiveSheet
        For x = .Range("B" & .Rows.Count).End(xlUp).Row To 2 Step -1
            If WorksheetFunction.CountA(.Rows(x)) = 0 Then .Rows(x).Delete
        Next

        For Each cellA In .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Offset(0, -1)
            bFlag = False
            Set cellB = cellA.Offset(0, 1)
            If cellA.Value = 0 AND cellB.Value = 0 Then
                'Do Nothing
            ElseIf cellA.Value = "" Or cellB.Value = "" Then
                bFlag = True
            ElseIf cellA.Value Like "##" And Not cellB.Value Like cellA.Value & "#####" Then
                bFlag = True
            ElseIf cellA.Value Like "###" And Not cellB.Value Like cellA.Value & "#####" Then bFlag = True
                bFlag = True
            End If

            If bFlag Then
                msg = msg & cellA.Address(False, False) & " : " & cellA.Value & vbTab & cellB.Address(False, False) & " : " & cellB.Value & vbNewLine
            End If
        Next

    End With
    Application.ScreenUpdating = True

    If Len(msg) > 0 Then MsgBox msg, vbInformation, "Errors Found"
End Sub

比较具有多个条件的列

1 个答案: