Excel 宏需要清理

我有一本我一直在写的工作簿。此工作簿有3张信息表，通过excel索引和匹配函数以及其他函数帮助填充主控表。母版图纸上的A2单元格是名称下拉框。选择每个名称时，一个链接到按钮的宏将帮助汇总信息，然后另一个按钮将工作表复制并粘贴到工作簿中的新工作表中。我的问题是关于总结信息的宏。由于不熟悉宏，我将其与互联网上收集的信息结合起来。我注意到它在使用时隐藏了一些行，这不是很好，而且工作非常慢。此外，这也不是很重要，它将粘贴放置在范围内的任何位置。甚至有时线路会分开，比如在E14和E16上，而不是在E14和E15上。我相信有更好的方法来编写这个宏，任何帮助和教育都将不胜感激

Sub UniqueValues()

Dim ws As Worksheet

'list states for install & service

Application.ScreenUpdating = False
Set ws = Sheets("MASTER")
ws.Range("D94:D144").AdvancedFilter Action:=x1FilterInPlace, Unique:=True
Range("D94:D144").Copy
ws.Range("E14:E19").PasteSpecial x1Values
Application.CutCopyMode = False
Application.ScreenUpdating = True

'list states for overrides

Application.ScreenUpdating = False
Set ws = Sheets("MASTER")
ws.Range("D147:D246")AdvancedFilter Action:=x1FilterInPlace, Unique:=True
Range("D147:D246").Copy
ws.Range("E21:E26").PasteSpecial x1Values
Application.CutCopyMode = False
Application.ScreenUpdating = True

'lists states for licenses

Application.ScreenUpdating = False
Set ws = Sheets("MASTER")
ws.Range("D249:D298").AdvancedFilter Action:=x1FilterInPlace, Unique:=True
Range("D249:D298").Copy
ws.Range("E35:E38").PasteSpecial x1Values
Application.CutCopyMode = False
Application.ScreenUpdating = True

'lists states for commissions

Application.ScreenUpdating = False
Set ws = Sheets("MASTER")
ws.Range("D301:D327").AdvancedFilter Action:=x1FilterInPlace, Unique:=True
Range("D301:D327").Copy
ws.Range("E28:E33").PasteSpecial x1Values
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

---

“就地”过滤器+复制粘贴将非常缓慢。如果您想改进代码，可以使用字典（可在Microsoft脚本运行时获得）

然后，您所要做的就是这样调用sub：

Sub ImprovedUniqueValues()
    Dim cell As Range, output As Range
    Dim ws As Worksheet

    Set ws = Sheets("MASTER")
    Set output = ws.Range("E19")

    getUniquesValues output, ws.Range("D94", ws.Range("D94").End(xlDown))
    ....
End Sub

---

感谢您抽出时间回答。我在测试中尝试了你的sub，但无法通过第一个sub。它在Dim Known Value As New Dictionary上给了我一个用户定义类型未定义错误，因此我确信我没有做正确的事情。另外，如果我理解的代码非常少，就像我刚刚学习的一样，那么您的.End（x1Down））会在空白处停止吗？这对于3个范围来说不是问题，但是范围（“D94:D144”）之间有一个空白区域。您需要添加对“Microsoft脚本运行时”库的引用。我添加了“.End（xlDown）”作为建议，在您的情况下，可能需要使用显式范围或使用“命名范围”调用函数。Best Regardi必须找到“参考”对话框。整个sub在显式范围内最适合我，但它太棒了。非常感谢你的教育。现在，我想知道如何通过投票给你一个好答案。

Sub ImprovedUniqueValues()
    Dim cell As Range, output As Range
    Dim ws As Worksheet

    Set ws = Sheets("MASTER")
    Set output = ws.Range("E19")

    getUniquesValues output, ws.Range("D94", ws.Range("D94").End(xlDown))
    ....
End Sub