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

谢谢！

米哈伊

宏Excel可根据单元格匹配将范围单元格从一个工作表复制到另一个工作表，如果不匹配则跳过单元格

4 个答案: