根据两个工作表中匹配的列值将单元格数据从一个工作表复制到另一个工作表

时间:2013-04-19 03:47:12

标签: excel excel-vba vba

我在论坛中看到了类似的(几乎相同的问题)。这是选择的答案。

代码:

Sub fixThis()
    Dim i As Long, j As Long, col1 As Long, col2 As Long, lastrow1 As Long, lastrow2 As Long
    Dim sheetOne As String
    Dim sheetTwo As String

    col1 = 5
    col2 = 1
    sheetOne = "Names"
    sheetTwo = "Job"
    lastrow1 = Sheets(sheetOne).Cells(Sheets(sheetOne).Rows.Count, col1).End(xlUp).Row
    lastrow2 = Sheets(sheetTwo).Cells(Sheets(sheetTwo).Rows.Count, col2).End(xlUp).Row

    For i = 2 To lastrow1
        For j = 2 To lastrow2
            If Sheets(sheetOne).Cells(i, col1).Value = Sheets(sheetTwo).Cells(j, col2).Value Then
                Sheets(sheetOne).Cells(i, 6).Value = Sheets(sheetTwo).Cells(j, 2).Value
            End If
        Next j
    Next i
End Sub

但我不知道如何将其转化为我的答案。

我有两张名为add and remove的表。我想比较两张纸的第一列。如果两个工作表中的值匹配,我想从工作表&#34复制status列的值;添加"表格"删除"匹配值。

请帮助我。

Ps:我是编码的初学者。

2 个答案:

答案 0 :(得分:0)

不需要VBA。这可以使用Vlookup实现。请参考下图。

enter image description here

答案 1 :(得分:0)

Sub fixThis()
    Dim i As Long, j As Long, colStatus As Long, lastrowAdd As Long, lastrowRemove As Long

    colStatus = 2 'your status column number
    lastrowAdd = Sheets("Add").Cells(Sheets("Add").Rows.Count, 1).End(xlUp).Row
    lastrowRemove = Sheets("Remove").Cells(Sheets("Remove").Rows.Count, 1).End(xlUp).Row

    For i = 1 To lastrowAdd 
        For j = 1 To lastrowRemove 
            If Sheets("Add").Cells(i, 1).Value = Sheets("Remove").Cells(j, 1).Value Then
                Sheets("Remove").Cells(j, colStatus).Value = Sheets("Add").Cells(i, colStatus).Value
            End If
        Next j
    Next i
End Sub