我对VBA不太满意,但我需要一个宏来比较两列数据,如果匹配,则将第二列旁边的列中的值复制到另一列。例如:
A B C D
123 1234 222
1234 123 567
1325
如果A和C匹配,那么与C相同的行中的列D中的值将被复制到列A的匹配行中的列B.A1匹配C2,因此D2被复制到B1。
我知道这可以使用VLOOKUP来完成,但是如果之后删除了C和D,它就不会成功。
提前谢谢大家。
答案 0 :(得分:0)
除非使用不同的事件处理程序,否则这是我的解决方案。
请注意:这绝不是一个高效的脚本,包含数千行的文件可能会被工具中的循环次数所困扰。
在Nutshell中说明:此宏中有两个主要功能,第一个功能明确地显示了您的请求。它在C列中搜索与A列中的单元格匹配的值。如果存在匹配值,则D列中的值将复制到B列中的相应单元格。
第二个功能会注意到C列中的Cell是否没有匹配的单元格并将其自身添加到A列的底部。由于这是一个单独的循环,因此可以省略它而不影响整体功能。
Option Explicit
Dim i As Integer, x As Integer, y As Integer
Dim CopyRow As Range, CopyRange As Range, SourceRow As Range, SourceRange As Range
Private Sub CommandButton1_Click()
Application.EnableEvents = False
'Sets last row used and ranges based on last row used
i = 1
While Sheets(1).Cells(i, 1) <> ""
i = i + 1
Wend
Set CopyRange = Sheets(1).Range("C1:C" & i)
x = 1
While Sheets(1).Cells(x, 3) <> ""
x = x + 1
Wend
Set SourceRange = Sheets(1).Range("A1:A" & x)
'Compares every cell value in A column with C column.
'If a value matches, copy the column from D to B
For Each SourceRow In SourceRange
For Each CopyRow In CopyRange
If CopyRow = SourceRow Then
SourceRow.Offset(, 1).Value = CopyRow.Offset(, 1).Value
End If
Next CopyRow
Next SourceRow
'Compares cells in A column with CElls in C column,
'if a cell in C column is no present in A column,
'then copy it and the value in D to A and B respectively.
For Each CopyRow In CopyRange
y = 0
For Each SourceRow In SourceRange
If CopyRow = SourceRow And CopyRow <> "" Then
y = y + 1
End If
Next SourceRow
If y = 0 Then
Sheets(1).Cells(i, 1).Value = CopyRow.Value
Sheets(1).Cells(i, 2).Value = CopyRow.Offset(, 1).Value
i = i + 1
End If
Next CopyRow
Application.EnableEvents = True
End Sub