Question

我尝试使用IF，AND＆amp;组合MATCH用于检查这些数据是否完全相同，如下所示。如何在Excel中使用VBA将它们对齐到同一行？

P / S：我找到了另一个有类似问题的帖子。然而，那就是插入一个我不想要的新专栏。

=IF(AND(MATCH(I:I,A:A,0),MATCH(J:J,B:B,0),MATCH(K:K,C:C,0),MATCH(L:L,D:D,0),MATCH(M:M,E:E,0)),"Match","Not Match")

A   B   C   D   E               I   J   K   L   M
---------------------------------------------------
A   1   1   1   1               B   2   2   2   2
B   2   2   2   2               K   11  11  11  11
C   3   3   3   3               I   9   9   9   9
D   4   4   4   4               H   8   8   8   8
E   5   5   5   5               A   1   1   1   1
F   6   6   6   6               C   3   3   3   3
G   7   7   7   7               E   5   5   5   5
H   8   8   8   8               D   4   4   4   4
I   9   9   9   9                               
J   10  10  10  10                              
K   11  11  11  11                              
L   12  12  12  12

这是预期的结果。

A   B   C   D   E               I   J   K   L   M         O
-------------------------------------------------------------
A   1   1   1   1               A   1   1   1   1       Match
B   2   2   2   2               B   2   2   2   2       Match
C   3   3   3   3               C   3   3   3   3       Match
D   4   4   4   4               D   4   4   4   4       Match
E   5   5   5   5               E   5   5   5   5       Match
F   6   6   6   6                                       
G   7   7   7   7                                       
H   8   8   8   8               H   8   8   8   8       Match
I   9   9   9   9               I   9   9   9   9       Match
J   10  10  10  10                                      
K   11  11  11  11              K   11  11  11  11      Match
L   12  12  12  12

Answer 1

首先选择两个范围，然后运行以下代码：

Sub Matchrows()
'Matches two ranges by inserting lines in both ranges so each value is on the same line

'you first need to
'   sort the two data blocks on the first column
'   select the two data blocks you want to split and match

Dim rg1 As range, rg2 As range, firstMatch As Boolean
Dim i As Long, j As Long, foundRow As Long

application.ScreenUpdating = False

    If selection.Areas.Count <> 2 Then
        MsgBox "Select two areas"
        Exit Sub
    End If

    Set rg1 = selection.Areas(1)
    Set rg2 = selection.Areas(2)

    'gets the number of unique values in the first rows of range 1 and 2, to be able to run the loop all the way
    Dim cUnique As New Collection

    On Error Resume Next

    With rg1
        For i = 1 To .Columns(1).Cells.Count
            cUnique.Add .Cells(i, 1), CStr(.Cells(i, 1))
        Next
    End With

    With rg2
        For i = 1 To .Columns(1).Cells.Count
            cUnique.Add .Cells(i, 1), CStr(.Cells(i, 1))
        Next
    End With

    On Error GoTo 0

    'boolean needed to be able to resize range 2 if required
    firstMatch = True

    For i = 1 To cUnique.Count
        If WorksheetFunction.CountA(rg1.Rows(i)) = 0 _
            Or WorksheetFunction.CountA(rg2.Rows(i)) = 0 _
            Or rg1.Cells(i, 1).Offset(0, rg2.Column - rg1.Column) = rg1.Cells(i, 1) Then
                firstMatch = False
                GoTo nxt_i:
        End If

        On Error Resume Next
        foundRow = rg2.Columns(1).Find(What:=rg1.Cells(i, 1), LookIn:= _
            xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row

        If Err <> 0 Then
            Err.Clear
            rg1.Cells(i, 1).Offset(0, rg2.Column - rg1.Column).Resize(, rg2.Columns.Count).Insert Shift:=xlDown
            If firstMatch Then Set rg2 = rg2.Offset(-1).Resize(rg2.Rows.Count + 1)
        Else
            If i < foundRow Then
                rg1.Offset(i - 1).Cut Cells(foundRow, rg1.Column)
            Else
                rg2.Rows(foundRow - rg2.Row + 1).Cut
                rg2.Rows(i).Insert Shift:=xlDown
            End If

            firstMatch = False
        End If

nxt_i:

    Next

application.ScreenUpdating = True
End Sub

使用VBA将重复值对齐到同一行

1 个答案: