首页 文章

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

提问于
浏览
2

我需要一些帮助,为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循环来确保两个元素匹配,但我不确定如何做到这一点 . 任何帮助表示赞赏 .

子比较()

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

结束子

2 回答

  • 0
    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列,以便找到匹配项 .

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

  • 1

    试试这个:

    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
    

相关问题