Question

我写了一篇有趣的宏（我刚开始学习VBA）来遍历sheet1中列中的名称列表，如果名称与sheet2中的similliar列表匹配，则将其余数据粘贴到Sheet2中。但它让我给出了一个应用程序错误，虽然我已经检查了我的代码无数的时间我很确定是一些愚蠢的错误但我无法找到它。

Option Explicit


Sub RangePasteColumn()
Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long
Dim MyName As String

Sheets("sheet1").Activate
lastRow1 = Sheets("sheet1").Range("E" & Rows.Count).End(xlUp).Row

For j = 4 To lastRow1
MyName = Sheets("sheet1").Cells(j, "E").Value

Sheets("sheet3").Activate
lastRow2 = Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow2
    If Sheets("sheet3").Cells(i, "A").Value = MyName Then
    Sheets("sheet1").Activate
    Sheets("sheet1").Range(Cells(j, "F"), Cells(j, "I")).Copy
    Sheets("sheet3").Activate
    Sheets("sheet3").Range(Cells(i, "B"), Cells(i, "E")).Select
    ActiveSheet.Paste
End If

Next i
Application.CutCopyMode = False

Next j
Sheets("sheet3").Activate
Sheets("sheet3").Range("A1").Select

End Sub

我知道你可以为这个任务做一个简单的vlookup或索引/匹配函数，我只是为了学习而不是为了工作。希望你们能在这里指导我。

是的，还有一件事，我想知道我是否可以在我的vba代码中使用偏移量，而不是写入要复制的范围。如果你知道，请告诉我。

谢谢

Answer 1

您好，欢迎来到StackOverflow。

这是我提出的解决方案。希望能为您提供一些有关如何继续简化代码并避免不相关编码的见解。请让我知道这对你有没有用。请在运行宏之前保存副本（如您所愿）。

问候，

  Option Explicit
Sub RangePasteColumn()
Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long
Dim sh_1, sh_3 As Worksheet 'Dim for the worksheet objects we will create below
Dim MyName As String

Set sh_1 = Sheets("sheet1") 'These objects avoid you having to write Sheets("SheetX") multiple times
Set sh_3 = Sheets("sheet3")

'Sheets("sheet1").Activate - There is no need to use Activate/Select a range or sheet. You can work on them by accessing
'the values directly
lastRow1 = sh_1.UsedRange.Rows.Count 'This is a better function to get the last used row (though there are disagreements on this)

For j = 4 To lastRow1
MyName = sh_1.Cells(j, 5).Value 'Column E = 5

'Sheets("sheet3").Activate - Again no need to use Activate a sheet
lastRow2 = sh_3.UsedRange.Rows.Count

    For i = 2 To lastRow2
        If sh_3.Cells(i, 1).Value = MyName Then 'Column A =1
            'Sheets("sheet1").Activate - I think you understood already :P
            sh_3.Cells(i, 2).Value = sh_1.Cells(j, 6).Value 'This is much better, faster way to "copy and paste" values
            sh_3.Cells(i, 3).Value = sh_1.Cells(j, 7).Value
            sh_3.Cells(i, 4).Value = sh_1.Cells(j, 8).Value
            sh_3.Cells(i, 5).Value = sh_1.Cells(j, 9).Value
            'Sheets("sheet3").Activate - Hopefully you did!
            'Sheets("sheet3").Range(Cells(i, "B"), Cells(i, "E")).Select
            'ActiveSheet.Paste
        End If

    Next i

Next j
'Sheets("sheet3").Activate - You most definitely did
'Sheets("sheet3").Range("A1").Select - Yeah! no need to use select either
MsgBox "Process Finished!"
End Sub

Answer 2

我会尝试这样的事情。预先定义您的范围，然后迭代每个范围并使用.Copy Destination:=构造来移动数据。

Sub RangePasteColumn()
    Dim names As Range, name As Range, values As Range, value As Range

    Set names = Worksheets("Sheet1").Range("E4:E" & Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row)
    Set values = Worksheets("Sheet3").Range("A2:A" & Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row)

    For Each name In names
        For Each value In values
            If name.value = value.value Then
                Worksheets("Sheet1").Range("F" & name.Row & ":I" & name.Row).Copy Destination:=Worksheets("Sheet3").Range("B" & value.Row & ":E" & value.Row)
            End If
        Next value
    Next name
End Sub

如果值匹配，则将数据粘贴到另一列

2 个答案: