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

为了好玩(我刚刚开始学习VBA),我写了macros来循环遍历sheet1中列中的名称列表,如果名称与sheet2中的similliar列表相匹配,则将其余数据粘贴到sheet2中。 但它让我给应用程序的错误,虽然我检查了我的代码无数次我很确定是一个愚蠢的错误,但我无法find它。

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 

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

是的,还有一件事,我想知道如果我可以在我的VBA代码中使用偏移量,而不是写在哪个范围内复制。 如果你知道,请让我知道。

谢谢

你好,欢迎来到StackOverflow。

这是我想出的解决scheme。 希望能给你一些关于如何继续精简你的代码和避免不相关代码的见解。 请让我知道这对你有没有用。 在运行macros之前,请保存一份副本(应该始终如此)。

问候,

  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 

我会尝试这样的事情。 预先定义您的范围,然后遍历每个范围,并使用.Copy Destination:= construction来移动数据。

 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