需要遍历列范围的代码，检查是否存在多个值，然后复制单元格
我需要一些帮助写一些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的外观：
ABC 1 Company Name Company Interests Contact 2 Apple Inc Waterskiing Bruce Kemp 3 Grape Pty Bush walking Steve Sampson 4 Pear Pty 5 Peach Pty Movies 6 Watermelon Pty Reading Books Bob Brown 7 Honey Pty Sports Luis White
我想要做的是循环所有公司名称（A栏）和工作表Sheet2中的公司权益，并在Master工作表中检查公司名称（A栏）和公司权益。
如果两个条件都find匹配项，则将Sheet2（C列）的联系人列中包含的值复制到Master中的联系人列（C列），以获取正确的行。
如果找不到匹配，则Sheet2中的整个行将被复制到主工作表中的第一个空行。
以前发布这个问题的人只需要公司名称匹配，并且用户提供了下面的代码。 我相信只需要添加一个额外的For循环，以确保两个元素匹配，但我不确定如何做到这一点。 任何帮助表示赞赏。
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
结束小组
If .Cells(i, 1) = WS.Cells(j, 1) Then
应该改成
If .Cells(i, 1) = WS.Cells(j, 1) And .Cells(i, 2) = WS.Cells(j, 2) Then
以表示我们正在检查A和B列以find匹配。
然后WS.Cells(j, 3) = .Cells(i, 2)应该改为WS.Cells(j, 3) = .Cells(i, 3)来填充C列的最后一段数据。
尝试这个：
Option Explicit Sub match() Dim wb As Workbook Dim wsM As Worksheet, ws2 As Worksheet Dim i As Integer, j As Integer Dim lastrow As Long, lastrow2 As Long Set wsM = Sheets("Master") Set ws2 = Sheets("Sheet2") lastrow = wsM.Range("A" & Rows.Count).End(xlUp).Row lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To lastrow2 For j = 2 To lastrow ' Check your 2 condition Column A and B of both sheets If wsM.Range("A" & j) = ws2.Range("A" & i) And wsM.Range("B" & j) = ws2.Range("B" & i) Then wsM.Range("C" & j) = ws2.Range("C" & i).Value End If Next j ' If no match then past in the master sheet ws2.Range("A" & i & ":" & "C" & i).Copy wsM.Range("A" & lastrow + 1) lastrow = wsM.Range("A" & Rows.Count).End(xlUp).Row Next i End Sub