匹配、删除自动左移单元格并报告匹配单元格的列

Question

我有一个 11 列 5 行的表格

列以这种方式标记 A ,1 ,2 ,3 ,4 ,5 ,6 ,7 ,8 ,9 ,10 ,ADD

CLA 是手动输入单元 CL1 始终等于 CLA。

A，是已经包含单个数字形式的输入的单元格。

给定，第一行包含从 0-9 随机排列的数字

在下一行宏必须将上面的行，CL1复制到CL0，然后它必须考虑CL1中的值，通过同一行匹配它，如果找到匹配，则删除匹配的单元格并将单元格向左移动。 CL1 的值现在必须与上面的行匹配，并且它的地址必须报告到 ADD 列。地址表示上列中匹配单元格的列标签。然后移动到下一行。

第一

CLA CL1 CL2 CL3 CL4 CL5 CL6 CL7 CL8 CL9 CL10 添加

     1   2   3   4   5   6   7   8   9   0      

 3   3   1   2   4   5   6   7   8   9   0   CL3

然后我在下一行的CLA中输入值（手动输入），在这种情况下为3。总是cl1 = cla）

它必须这样做，直到所有 CLA 都完成为止。 CLA 是预填充的，cl1 也是预填充的。

必须如何完成的示例步骤

开始 -> 将上面的行从 CL1 复制到 CL10

CLA CL1 CL2 CL3 CL4 CL5 CL6 CL7 CL8 CL9 CL10 添加

     1   2   3   4   5   6   7   8   9   0      

 3   3   1   2   4   5   6   7   8   9   0   CL3

 6   

-> 把它们放在 CL2 中（我会输入 CLA 和 CL1 有这个预填充公式 =CL1=CLA

CLA CL1 CL2 CL3 CL4 CL5 CL6 CL7 CL8 CL9 CL10 添加

     1   2   3   4   5   6   7   8   9   0      

 3   3   1   2   4   5   6   7   8   9   0   CL3

 6   6   3   1   2   4   5   6   7   8   9   0    ( Copied from above in CL2 )

->匹配复制行中的CL1值并删除该单元格并将单元格向左移动。

CLA CL1 CL2 CL3 CL4 CL5 CL6 CL7 CL8 CL9 CL10 添加

     1   2   3   4   5   6   7   8   9   0      

 3   3   1   2   4   5   6   7   8   9   0   CL3

 6   6   3   1   2   4   5   7   8   9   0    ( 6 is deleted because it matches with cl1 in same row )

-> 现在转到 ADD 列并匹配上一行中的 CL1 In，并报告匹配单元格的列。在这种情况下 ADD 是 CL4，因为 3 ，即当前行中的 CL1，在上一行的 CL4 上。

CLA CL1 CL2 CL3 CL4 CL5 CL6 CL7 CL8 CL9 CL10 添加

     1   2   3   4   5   6   7   8   9   0      

 3   3   1   2   4   5   6   7   8   9   0   CL4

 6   6   3   1   2   4   5   7   8   9   0   CL7  ( Add is CL7 because 6 was in CL7 IN THE ABOVE ROW)

Answer 1

好的，这对我有用，可以根据您的评论使用一些错误处理和调整，但试一试它适用于 CLA 中的手动输入

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CLA As Integer
    If Target.Column = 1 Then
            CLA = Target.Value      
            Range("$B$" & Target.Row - 1, "$K$" & Target.Row - 1).Copy Destination:=Range("$C$" & Target.Row)
            Dim lcell As Range
            Dim previous_location As String
            Dim removable As String
            For Each lcell In Range("$C$" & Target.Row, "$K$" & Target.Row)
                If lcell = CLA Then
                    previous_location = Cells(1, lcell.Column - 1)
                    removable = lcell.Address
                    Cells(lcell.Row, 2) = CLA
                    Exit For
                End If
            Next lcell
            Range(removable).Delete
            Cells(Target.Row, "L") = previous_location
    End If
End Sub

Answer 2

这是我现在一直在使用的。我不是 VBA 专家，我知道这是不好的编码。但根据解决方案，它是完美的。它处理 12 列。它有点慢。随着它一步一步地进行。欢迎任何加快代码处理的建议。谢谢

Sub Macro1()
Dim X As Integer
Dim A As Integer
Dim R As Integer
Dim D As Integer
'Two variables will do the work
X = 2
A = 2
D = 1
R = 2
'Adjust COUNTER as per need of Columns that need to be processed
For COUNTER = 1 To 6
Cells(X, 1).Select
Selection.Copy
Cells(A, 2).Select
ActiveSheet.Paste
Range(Cells(D, 2), Cells(D, 13)).Select
Selection.Copy
Cells(X, 3).Select
ActiveSheet.Paste 
'Adress Section
If Cells(R, 2) = Cells(R, 3) Then Cells(R, 16).Value = 1
If Cells(R, 2) = Cells(R, 4) Then Cells(R, 16).Value = 2
If Cells(R, 2) = Cells(R, 5) Then Cells(R, 16).Value = 3
If Cells(R, 2) = Cells(R, 6) Then Cells(R, 16).Value = 4
If Cells(R, 2) = Cells(R, 7) Then Cells(R, 16).Value = 5
If Cells(R, 2) = Cells(R, 8) Then Cells(R, 16).Value = 6
If Cells(R, 2) = Cells(R, 9) Then Cells(R, 16).Value = 7
If Cells(R, 2) = Cells(R, 10) Then Cells(R, 16).Value = 8
If Cells(R, 2) = Cells(R, 11) Then Cells(R, 16).Value = 9
If Cells(R, 2) = Cells(R, 12) Then Cells(R, 16).Value = 10
If Cells(R, 2) = Cells(R, 13) Then Cells(R, 16).Value = 11
If Cells(R, 2) = Cells(R, 14) Then Cells(R, 16).Value = 12

'DeleteSection
If Cells(R, 2) = Cells(R, 3) Then Cells(R, 3).Delete xlToLeft
If Cells(R, 2) = Cells(R, 4) Then Cells(R, 4).Delete xlToLeft
If Cells(R, 2) = Cells(R, 5) Then Cells(R, 5).Delete xlToLeft
If Cells(R, 2) = Cells(R, 6) Then Cells(R, 6).Delete xlToLeft
If Cells(R, 2) = Cells(R, 7) Then Cells(R, 7).Delete xlToLeft
If Cells(R, 2) = Cells(R, 8) Then Cells(R, 8).Delete xlToLeft
If Cells(R, 2) = Cells(R, 9) Then Cells(R, 9).Delete xlToLeft
If Cells(R, 2) = Cells(R, 10) Then Cells(R, 10).Delete xlToLeft
If Cells(R, 2) = Cells(R, 11) Then Cells(R, 11).Delete xlToLeft
If Cells(R, 2) = Cells(R, 12) Then Cells(R, 12).Delete xlToLeft
If Cells(R, 2) = Cells(R, 13) Then Cells(R, 13).Delete xlToLeft
If Cells(R, 2) = Cells(R, 14) Then Cells(R, 14).Delete xlToLeft
X = X + 1
A = A + 1
D = D + 1
R = R + 1
Next COUNTER
End
End Sub