VBA字典匹配/复制/粘贴不起作用答案

【问题标题】：VBA Dictionary to Match/Copy/Paste not workingVBA字典匹配/复制/粘贴不起作用
【发布时间】：2018-05-10 16:43:45
【问题描述】：

有人建议我将此作为第二个问题发布，但这在某种程度上是我在here 找到的第一个问题的延续。

我有用于匹配列并将第三个值粘贴到正确行的另一列中的代码（脚本字典）。现在，我遇到的问题（新问题）是代码似乎没有开始从我的检查表的第一行粘贴到我的主表的第一行。假设每张工作表都有很多记录，并且不断添加新记录（这就是我尝试不使用限制性定义范围的原因）。

像这样：

Lavoie 将他所有的 WO#s 都记录在自己的小纸上。他打算自己手动更新“日期检查员清除”，然后点击一个按钮，然后在通过 WO#（始终唯一且从不重复）匹配到 WO 后，将该日期复制粘贴到主表中的 R 列# 在主表中（2018 年）。下面的图片（我不得不把一些敏感信息涂黑——假设它不重要。）

Lavoie 的单子：

主表：

这是我的代码：

Sub dates()

Application.ScreenUpdating = False

Dim AVals As Object: Set AVals = CreateObject("scripting.dictionary")
Dim i As Long, j As Long, lastRow1 As Long, lastRow2 As Long
Dim sh_insp, sh_2018 As Worksheet
Dim MyName As String

Set sh_insp = ActiveSheet
Set sh_2018 = Sheets("2018")

With sh_insp
    lastRow1 = .Range("A:A").Rows.Count 'last row in spreadsheet
    lastRow1 = .Cells(lastRow1, 7).End(xlUp).Row 'last used row in column G
    'load the AVal dict
    For j = 18 To lastRow1
        MyName = .Cells(j, 7).Value
        If Len(MyName) > 0 And Len(.Cells(j, 18)) > 0 Then AVals.Add MyName, .Cells(j, 18).Value
    Next j
End With

With sh_2018
    lastRow2 = .Range("A:A").Rows.Count
    lastRow2 = .Cells(lastRow2, 7).End(xlUp).Row 'last used row in column G
    For i = 18 To lastRow2
        MyName = .Cells(i, 7).Value
        If AVals.Exists(MyName) Then
            .Cells(i, 18).Value = AVals.Item(MyName)
        End If
     Next i
End With
Application.ScreenUpdating = True

End Sub

我的 WO#s 已被清除 - 为什么代码副本不会粘贴这些值，为什么会跳过？

【问题讨论】：

您应该阅读minimal reproducible example。不知道这是否是您的问题的原因，但Set sh_insp = ActiveSheet 是有风险的，因为可能在运行代码时错误的工作表处于活动状态？
@SJR，我有另一个宏运行用户表单并限制访问，因此始终显示正确人员的正确工作表:)。但我会读的，谢谢你的链接！

标签： excel vba

【解决方案1】：

数据从第 2 行或第 3 行开始，您开始向字典中添加记录并从第 18 行验证 2018 中的记录

将 18 更改为这些行中的正确行：

For j = 18 To lastRow1
For i = 18 To lastRow2

【讨论】：