匹配两个字符串然后复制粘贴数据

Question

我一直在尝试创建一个函数，它将 2 个单独的字符串与两列匹配，然后复制相应的列数据并粘贴到单独的 sheet。

我被困在那个问题上 如何进行 2 场比赛 就像 For Each cell In myDataRng & myDataRng2。

我们将不胜感激您的帮助

Sub Tester()
    
    Dim myDataRng, myDataRng2 As Range
    Dim cell As Range, wsSrc As Worksheet, wsDest As Worksheet
    Dim destRow As Range
    Dim FindValue As String
    Dim FindValue2 As String
    
    Set wsSrc = Worksheets("Sheet1")  'source sheet
    Set wsDest = Worksheets("Sheet2") 'destination sheet
    
    FindValue = wsDest.Range("A2").Value
    FindValue2 = wsDest.Range("B2").Value
    
    Set myDataRng = wsSrc.Range("F2:F" & wsSrc.Cells(Rows.Count, "F").End(xlUp).Row)
    Set myDataRng2 = wsSrc.Range("A2:A" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row)
    
    Set destRow = wsDest.Rows(2)  'first destination row
    
    For Each cell In myDataRng
        If InStr(1, cell.Value, FindValue) > 0 Then
        
            With cell.EntireRow 'the whole matching row
                destRow.Cells(5).Value = .Cells(2).Value
                destRow.Cells(6).Value = .Cells(3).Value
                destRow.Cells(7).Value = .Cells(4).Value
                destRow.Cells(8).Value = .Cells(5).Value
            End With
            
            Set destRow = destRow.Offset(1, 0) 'next destination row
            
        End If
    Next cell

End Sub

其他情况

Sub find()

Dim foundRng As Range
Dim mValue As String

Set shData = Worksheets("Sheet1")
Set shSummary = Worksheets("Sheet2")

mValue = shSummary.Range("C2")

    Set foundRng = shData.Range("G1:Z1").find(mValue)
    'If matches then copy macthed Column and paste into Sheet2 Col"I" (as above code psting the data into Sheet2)
    
End Sub

Answer 1

多个选项：

If Instr(1, cell.Offset(,-5).Value, FindValue2) > 0 Then

If InStr(1, wsSrc.Range("A" & cell.Row), FindValue2) > 0 Then

和其他人。

Answer 2

我喜欢像这样在循环中使用行，因为它使阅读代码和理解正在发生的事情变得非常容易。通过将搜索范围分成一系列行，一切都变得易于写入和读取。

Sub Tester()
    
    Dim myDataRng, myDataRng2 As Range
    Dim rRow As Range, wsSrc As Worksheet, wsDest As Worksheet
    Dim destRow As Range
    Dim FindValue As String
    Dim FindValue2 As String
    
    Set wsSrc = Worksheets("Sheet1")  'source sheet
    Set wsDest = Worksheets("Sheet2") 'destination sheet
    
    FindValue = wsDest.Range("A2").Value
    FindValue2 = wsDest.Range("B2").Value
    
    Set myDataRng = wsSrc.Range("F2:F" & wsSrc.Cells(Rows.Count, "F").End(xlUp).Row)
    'Set myDataRng2 = wsSrc.Range("A2:A" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row)
    
    Set destRow = wsDest.Rows(2)  'first destination row
    
    For Each rRow In myDataRng.Rows.EntireRow
        If InStr(1, rRow.Columns("F").Value, FindValue) > 0 _
        And InStr(1, rRow.Columns("A").Value, FindValue2) > 0 Then
        
            With rRow.EntireRow 'the whole matching row
                destRow.Cells(5).Value = .Cells(2).Value
                destRow.Cells(6).Value = .Cells(3).Value
                destRow.Cells(7).Value = .Cells(4).Value
                destRow.Cells(8).Value = .Cells(5).Value
            End With
            
            Set destRow = destRow.Offset(1, 0) 'next destination row
            
        End If
    Next rRow

End Sub
    Set wsSrc = Worksheets("Sheet1")  'source sheet
    Set wsDest = Worksheets("Sheet2") 'destination sheet
    
    FindValue = wsDest.Range("A2").Value
    FindValue2 = wsDest.Range("B2").Value
    
    Set myDataRng = wsSrc.Range("F2:F" & wsSrc.Cells(Rows.Count, "F").End(xlUp).Row)
    'Set myDataRng2 = wsSrc.Range("A2:A" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row)
    
    Set destRow = wsDest.Rows(2)  'first destination row
    
    For Each rRow In myDataRng.Rows
        If InStr(1, rRow.Columns("F").Value, FindValue) > 0 _
        And InStr(1, rRow.Columns("A").Value, FindValue2) > 0 Then
        
            With rRow.EntireRow 'the whole matching row
                destRow.Cells(5).Value = .Cells(2).Value
                destRow.Cells(6).Value = .Cells(3).Value
                destRow.Cells(7).Value = .Cells(4).Value
                destRow.Cells(8).Value = .Cells(5).Value
            End With
            
            Set destRow = destRow.Offset(1, 0) 'next destination row
            
        End If
    Next rRow

End Sub

匹配两个字符串然后复制粘贴数据

Matching Two Strings then copy paste Data

excel

vba

match