我有一个包含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)
答案 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