比较Excel

时间:2018-04-05 18:06:05

标签: excel vba excel-vba compare

我对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,它就不会成功。

提前谢谢大家。

1 个答案:

答案 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