vba查找值，然后粘贴到另一列的另一个单元格中

我目前正在运行一个macros，它从表单2的C列的'表单1'的列A中查找值，如果匹配，则表单1的列B的值应该被复制到相应行的列M中表2

macros我有工作，但因为这是一个巨大的工作表，其中的循环是花费太多的时间。 这是因为工作表1有大约30万行，每个实例的值都是唯一的。 在工作表2中，大约有50,000行。 它一夜之间就已经运行了，到目前为止，在表1中只有6万行

我绝不是一个VBA专家，甚至是中间人，但是从我读过的内容来看，使用Find可以比寻找匹配和循环更快吗？

这是我目前使用的macros

Option Explicit Sub lookupandcopy() Application.Screenupdating = True Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long Dim sh_1, sh_3 As Worksheet Dim MyName As String Set sh_1 = Sheets("sheet1") Set sh_3 = Sheets("sheet2") lastRow1 = sh_1.UsedRange.Rows.Count For j = 2 To lastRow1 MyName = sh_1.Cells(j, 1).Value lastRow2 = sh_3.UsedRange.Rows.Count For i = 2 To lastRow2 If sh_3.Cells(i, 3).Value = MyName Then sh_3.Cells(i, 13).Value = sh_1.Cells(j, 2).Value End If Next i Next j Application.Screenupdating = True End Sub 

如果我遗漏了任何东西或任何其他需要的细节，请让我知道！

Answer 1

您似乎使用sheet1中的列A和B作为字典（并通过线性search来访问这些值）。 为什么不将值加载到具有O（1）search的字典对象中？ 确保您的项目包含对Microsoft脚本运行时的引用（VBE中的工具>引用，如果您还没有这样做），请尝试：

 Sub lookupandcopy() Application.ScreenUpdating = False Dim AVals As New Dictionary Dim i As Long, j As Long, lastRow1 As Long, lastRow2 As Long Dim sh_1, sh_3 As Worksheet Dim MyName As String Set sh_1 = Sheets("sheet1") Set sh_3 = Sheets("sheet2") With sh_1 lastRow1 = .Range("A:A").Rows.Count 'last row in spreadsheet lastRow1 = .Cells(lastRow1, 1).End(xlUp).Row 'last used row in column A 'load the AVal dict For j = 2 To lastRow1 MyName = .Cells(j, 1).Value If Len(MyName) > 0 Then AVals.Add MyName, .Cells(j, 2).Value Next j End With With sh_3 lastRow2 = .Range("A:A").Rows.Count lastRow2 = .Cells(lastRow2, 3).End(xlUp).Row 'last used row in column 3 For i = 2 To lastRow2 MyName = .Cells(i, 3).Value If AVals.Exists(MyName) Then .Cells(i, 13).Value = AVals.Item(MyName) End If Next i End With Application.ScreenUpdating = True End Sub 

如果你在列A中有重复的值，那么你需要做一些操作，比如存储行值索引值的值，但是设置这样一个字典的努力仍然会比使用嵌套循环更好。