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

我需要一些帮助写一些Excel的VBA。 我有一个电子表格和两个工作表。 一个工作表被称为主，另一个被称为Sheet2。 这是主工作表的样子：

ABC 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的外观：

  AB 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）。

如果find一个匹配，Sheet 2（B列）的Contact列中包含的值将被复制到Master中的Contact列（列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