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

时间:2014-09-03 20:24:48

标签: excel vba

我有一个包含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 ADD

     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' S完成。 CLA预先填充,cl1也预先填充。

必须完成的示例步骤

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

CLA CL1 CL2 CL3 CL4 CL5 CL6 CL7 CL8 CL9 CL10 ADD

     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 ADD

     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 ADD

     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 ADD

     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)

2 个答案:

答案 0 :(得分:0)

好的,这对我来说可以根据你的评论使用一些错误处理和改编,但是给它一个镜头它适用于手动输入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

答案 1 :(得分:0)

这就是我现在一直在使用的东西。我不是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