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

【问题标题】：Matching Two Strings then copy paste Data匹配两个字符串然后复制粘贴数据
【发布时间】：2021-08-09 13:20:09
【问题描述】：

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

我被困在那件事上如何进行 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

【问题讨论】：

标签： excel vba match

【解决方案1】：

几个选项：

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

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

和其他人。

【讨论】：

非常感谢@BigBen 我环顾四周，即使我用谷歌搜索找到答案，但找不到类似的东西。这真是太棒了。
如果没有您的工作簿，将很难准确了解。我在您的代码中没有看到任何会导致问题的内容。
那还不错。据我所知，您只是将值从源表复制到目标表。这很简单。添加第二个InStr 检查不应损坏文件。所以，不确定是什么问题。除了上面的 sn-p 之外，您的代码还有其他功能吗？
shData.Rows("2:20").Columns(foundRng.Column).Copy。您可能必须使行 2:20 动态。
With shData, Dim lastRow As Long, lastRow = .Cells(.Rows.Count, foundRng.Column).End(xlUp).Row, .Rows("2:" & lastRow).Columns(foundRng.Column).Copy, End With.

【解决方案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

【讨论】：

感谢@Toddleson 的解决方案