Question

我有一本我一直在做的工作簿。此工作簿有3页信息，有助于通过Excel索引和匹配函数以及其他功能填充MASTER表。 MASTER表上的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

Answer 1

＆＃39;到位＆＃39;过滤器+复制粘贴会很慢。如果要改进代码，可以使用字典（可在Microsoft Scripting Runtime中使用）

Sub getUniquesValues(output As Range, cells As Range)
    Dim cell As Range
    Dim knownValues As New Dictionary

    For Each cell In cells
        If Not knownValues.Exists(cell.Value) Then
            output = cell.Value
            Set output = output.Offset(1, 0)
            knownValues.Add cell.Value, 1
        End If
    Next
End Sub

然后你所要做的就是用这种方式调用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

宏需求得到了清理

1 个答案: