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                C 
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

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

如果找到两个条件的匹配项，则将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

End Sub

Answer 1

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列和A列。 B为了找到匹配。

然后WS.Cells(j, 3) = .Cells(i, 2)应更改为WS.Cells(j, 3) = .Cells(i, 3)以填写C列的最后一段数据。

Answer 2

试试这个：

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

循环列范围所需的代码，检查是否存在多个值，然后复制单元格

2 个答案: