Question

我需要一些帮助，为Excel编写一些VBA。我有一个包含两个工作表的电子表格。一个工作表称为Master，另一个称为Sheet2。以下是Master工作表的样子：

            A               B                  C
1   Company Name        Company Interests   Contact 
2   Apple Inc           Waterskiing         
3   Grape Pty           Bush walking        
4   Pear Pty        
5   Peach Pty           Movies
6   Watermelon Pty      Reading Books       Bob Brown

这是Sheet2的样子：

          A                B
1   Company Name        Contact 
2   Apple Inc           Bruce Kemp
3   Grape Pty           Steve Sampson
4   Pear Pty        
5   Peach Pty       
6   Watermelon Pty      Bob Brown
7   Honey Pty           Luis White

我想要做的是遍历工作表Sheet2中的所有公司名称（A列），并检查主工作表中的公司名称（A列）。

如果找到匹配项，则将Sheet2的联系人列（B列）中包含的值复制到Master中的联系人列（C列）以获取正确的行。

如果未找到匹配项，则Sheet2中的整行将复制到主表单中的第一个空行。

Answer 1

不确定你对VBA有多舒服，所以我对代码进行了彻底的评论。希望这有帮助！

Sub Compare()

    Dim WS As Worksheet
    Set WS = Sheets("Master")

    Dim RowsMaster As Integer, Rows2 As Integer
    RowsMaster = WS.Cells(1048576, 1).End(xlUp).Row
    Rows2 = Worksheets(2).Cells(1048576, 1).End(xlUp).Row
    ' Get the number of used rows for each sheet

    With Worksheets(2)
        For i = 2 To Rows2
        ' Loop through Sheet 2
            For j = 2 To RowsMaster
            ' Loop through the Master sheet
                If .Cells(i, 1) = WS.Cells(j, 1) Then
                ' If a match is found:
                    WS.Cells(j, 3) = .Cells(i, 2)
                    ' Copy in contact info
                    Exit For
                    ' No point in continuing the search for that company
                ElseIf j = RowsMaster Then
                ' If we got to the end of the Master sheet 
                ' and haven't found a company match
                    RowsMaster = RowsMaster + 1
                    ' Increment the number of rows
                    For k = 1 To 3 ' Change 3 to however many fields Sheet2 has
                        WS.Cells(RowsMaster, k) = .Cells(i, k)
                        ' Copy the data from Sheet2 in on the bottom row of Master
                    Next
                End If
            Next j
        Next i
    End With

End Sub

Answer 2

Sub compare()
    For i = 1 To last_cell_mainSheet
        For j = 1 To last_cell_sheet2
        If Worksheets("main_sheet").Range("a" & i).Value = Worksheets("sheet2").Range("a" & j).Value Then
           Worksheets("main_sheet").Range("C" & i).Value = Worksheets("sheet2").Range("b" & j).Value
        End If
        Next j
    Next i
End Sub

循环遍历列范围的代码，检查值是否存在然后复制单元格

2 个答案: