宏 Excel 根据单元格匹配将范围单元格从一张表复制到另一张表，如果不匹配则跳过单元格答案

【问题标题】：Macro Excel to copy range cells from one sheet to another based on cell match and skip cell if no match宏 Excel 根据单元格匹配将范围单元格从一张表复制到另一张表，如果不匹配则跳过单元格
【发布时间】：2015-03-23 17:08:41
【问题描述】：

我是 excel 中的宏的新手，我正在尝试创建一个可以帮助我根据匹配将数据从一张表复制到另一张表的宏。基本上我希望excel查看Sheet1中的H列，如果任何单元格中的数据将与Sheet2中E列中任何单元格的数据匹配，它将从Sheet1到Sheet2的列范围复制到相关行（找到匹配的地方） .

例如：如果 H5 (sheet1) 中的数据与 E1 (sheet2) 中的数据匹配，则应将单元格 I5 到 J5 (sheet1) 复制到单元格 F1 到 G1。

目前我有这个宏正在做部分工作：

Sub asd()
For Counter = 1 To 10
    If Sheets(1).Range("H" & Counter).Value = Sheets(2).Range("E" & Counter).Value Then
        Sheets(2).Range("F" & (Counter)).Value = Sheets(1).Range("I" & Counter).Value
        Sheets(2).Range("G" & (Counter)).Value = Sheets(1).Range("J" & Counter).Value
    End If
Next Counter
End Sub

它的问题在于，一旦 H 列（sheet1）与 E 列（Sheet2）之间不匹配，宏就会停止。如果在所有行都完成之前没有匹配，我相信有一种简单的方法可以让它跳转到下一行。

任何人都可以编辑此代码以使其工作吗？

【问题讨论】：

你确定它在没有匹配时停止，还是在 10 行后停止，因为这是你在 For Counter = 1 To 10 中指定的？尝试使用调试器一次单步执行您的代码（按 F8 执行每一行代码），看看发生了什么。

标签： excel copy match cells vba

【解决方案1】：

假设您希望代码运行的时间超过两张表的前 10 行，请尝试一下：

Sub asd()
'this runs through all used rows in sheet 1
For Counter = 1 To Sheets(1).UsedRange.Rows.Count  
  'this ensures that cell H<row> has a non-blank value
  'you can leave this If statement out if you know there will be no blanks in Column H
  If sheets(1).Range("H" & counter) <> "" then  
    If Sheets(1).Range("H" & Counter).Value = Sheets(2).Range("E" & Counter).Value Then
      Sheets(2).Range("F" & (Counter)).Value = Sheets(1).Range("I" & Counter).Value
      Sheets(2).Range("G" & (Counter)).Value = Sheets(1).Range("J" & Counter).Value
    End If
  End if
Next Counter
End Sub

【讨论】：

嗨！谢谢你的帮助！现在这是有线的。今天早上代码运行良好，我设法让它选择特定范围的列（使用这一行 Sheets(2).Range("F" & (Counter), "G" & (Counter)).Value = Sheets(1).Range("I" & Counter, "J" & Counter).Value)，但是一旦我设法做到了，代码就会再次开始工作，直到找到第一个未匹配项。连线的事情是，现在即使我完全复制/过去了你给我的代码，没有任何变化，它不再起作用，它在第一次不匹配时停止......你有什么想法吗我可以解决它吗？
您是否运行过调试器以准确查看失败的行以及失败时的所有变量？
您的代码没有错误，它正在工作，但根本没有遍历所有行......这很奇怪，因为它在开始时工作正常，然后突然停止了.但无论如何，我已经设法将您的代码与 Branislav Kollár 的代码结合起来，现在它可以按我的意愿工作了。非常感谢您的帮助！

【解决方案2】：

您需要 2 个循环来将 Sheet1 中的值与 Sheet2 中的所有其他值进行比较：

    Sub asd()

    Dim lngLastRowSht1 As Long
    Dim lngLastRowSht2 As Long
    Dim counterSht1 As Long
    Dim counterSht2 As Long

    With Worksheets(1)
        lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row
        lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
            For counterSht1 = 1 To lngLastRowSht1
                For counterSht2 = 1 To lngLastRowSht2
                    If .Cells(counterSht1, 8) = Worksheets(2).Cells(counterSht2, 5) Then
                        Worksheets(2).Cells(counterSht2, 6) = .Cells(counterSht1, 9)
                        Worksheets(2).Cells(counterSht2, 7) = .Cells(counterSht1, 10)
                    End If
                Next counterSht2
            Next counterSht1
    End With

End Sub

【讨论】：

【解决方案3】：

好家伙！两个代码都运行良好。

我还需要添加一件事。如何定义需要复制的列范围？例如而不是这行两次：

Sheets(2).Range("F" & (Counter)).Value = Sheets(1).Range("I" & Counter).Value
Sheets(2).Range("G" & (Counter)).Value = Sheets(1).Range("J" & Counter).Value

或者这两次

Worksheets(2).Cells(counterSht2, 6) = .Cells(counterSht1, 9)
Worksheets(2).Cells(counterSht2, 7) = .Cells(counterSht1, 10)

如何定义“我希望将 I 和 AL 之间的所有列（表 1）复制到 F 到 AI 之间的所有列（表 2）”？我必须处理 500 列，并且需要很长时间才能为每列做一行。

非常感谢！

米海

【讨论】：

【解决方案4】：

我结合了 FreeMan 和 Branislav Kollár 提供的两个建议，并提出了一个代码，该代码还可以选择要复制的更大范围。如果以后有人想要这个，请看下面我得到的代码：

Sub CopyCells()

Dim lngLastRowSht1 As Long
Dim lngLastRowSht2 As Long
Dim counterSht1 As Long
Dim counterSht2 As Long

With Worksheets(1)
    lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row
    lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
        For counterSht1 = 1 To lngLastRowSht1
            For counterSht2 = 1 To lngLastRowSht2
                If Sheets(1).Range("H" & (counterSht1)).Value = Sheets(2).Range("E" & counterSht2).Value Then
                    Sheets(2).Range("F" & (counterSht2), "H" & (counterSht2)).Value = Sheets(1).Range("I" & counterSht1, "K" & counterSht1).Value
                End If
            Next counterSht2
        Next counterSht1
End With
End Sub

谢谢！

米海

【讨论】：