Macro Excel可根据单元格匹配将范围单元格从一张纸复制到另一张纸，如果不匹配，则跳过单元格

Question

我是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）之间没有匹配，宏就会停止。 我确信如果没有匹配项，直到所有行都完成，有一种简单的方法可以使它跳到下一行。

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

Answer 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

Answer 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

Answer 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列，并且每列都要花很多时间。

非常感谢！

米海

Answer 4

我结合了FreeMan和BranislavKollá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

谢谢！

米海