Question

我想制作一个更快的Excel工作簿。

我有一个很大的产品数据库，其中包含产品名称，数量，交货编号和交货日期（ProductDB）。我在另一张纸上添加了我已售出的产品（产品名称和销售数量），并希望过滤和复制数据库中对应的产品，这样我就可以在第二步计算剩余数量并将剩余数量计算到数据库中。

一切运作良好，计算良好。唯一的问题是，如果我必须输入5000行产品名称，server1.on is not a function Advancedfilter选项太慢了。

我听说阵列要快得多。我怎么能这样做？我现在这样做的方式是这样的：

xlfiltercopy

根据销售的产品代码从数据库中过滤产品代码：

Sub UseFilter()

Application.ScreenUpdating = False

Sheet1.Range("G1:Z100000").Cells.Delete

Dim lastrow As Long, c As Range
Dim myrange As Range
Dim rngCell As Range
Dim wksSheet As Worksheet
Dim wksSheetDB As Worksheet

lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
Sheet1.Columns("G").NumberFormat = "0"

首先按产品代码对过滤后的列表进行排序，然后按交货编号排序：

Set myrange = Range("A1:A" & lastrow)

For Each c In myrange
    If Len(c.Value) <> 0 Then
                ThisWorkbook.Worksheets(Worksheets.Count).Columns("A:D").AdvancedFilter xlFilterCopy, _
            Sheet1.Range("A1:A" & lastrow), Sheet1.Range("G1"), False
    End If
Next

我只对过滤和复制相应的产品信息感兴趣（Dim lngRowMax As Long Dim wsf As WorksheetFunction With Sheet1 lastrow = Cells(Rows.Count, 8).End(xlUp).Row Range("G1:J" & lastrow).Sort Key1:=Range("G1:G" & lastrow), _ Order1:=xlAscending, Key2:=Range("I1:I" & lastrow), _ Order2:=xlAscending, Header:=xlYes, DataOption1:=xlSortTextAsNumbers Set wsf = Application.WorksheetFunction lngRowMax = .UsedRange.Rows.Count End With，name (A)，quantity (B)和delivery nr (C)）。有谁知道我怎么能这样做？

非常感谢您提前。我真的很期待能够提高文件节奏的解决方案。目前它的速度令人难以置信。

Answer 1

我遇到了同样的问题，高级过滤器太慢了。你可能想考虑使用字典。对于我的2个电子表格，我想比较我制作的2个词典并比较了这些值，它的速度非常快。字典非常简单，只需简单的谷歌搜索，你就可以找到大量的教程和例子。祝你好运。

Answer 2

There is a possible solution with dictionaries, but I have only one small issue. I will explain after the code:

'Count num rows in the database
NumRowsDB = ThisWorkbook.Worksheets(Worksheets.Count).Range("A2", Range("A2").End(xlDown)).Rows.Count

' --------------------- SAVE DATABASE DATA -----------------------

'Dictionary for all DB data
Set dbDict = CreateObject("Scripting.Dictionary")
Set dbRange = Range("A2:A" & (NumRowsDB + 1))

For Each SKU In dbRange
If Len(SKU.Value) <> 0 Then

    ' check if the SKU allready exists, if not create a new array list for that dictionary entry
    ' a list is necessary because there can be multiple entries in the db range with the same SKU
    If Not dbDict.Exists(CStr(SKU.Value)) Then
        Set prodList = CreateObject("System.Collections.ArrayList")
        dbDict.Add CStr(SKU.Value), prodList
    End If

    ' for this specific product code, save the range where the product information is saved in the dictionary
    rangeStr = "A" & SKU.Row & ":D" & SKU.Row
    dbDict(CStr(SKU.Value)).Add (rangeStr)

End If
Next

' ----------- READ SALE/Reverse/Consumption INFO ------------------

NumRowsSale = Range("A2", Range("A2").End(xlDown)).Rows.Count
Set saleRange = Range("A2:A" & (NumRowsSale + 1))

Dim unionRange As Range

For Each sale In saleRange
' check if the SKU for the sale exists in db
If Len(sale.Value) <> 0 And dbDict.Exists(CStr(sale.Value)) Then
    For Each dbRange In dbDict(CStr(sale.Value))
        If unionRange Is Nothing Then
            Set unionRange = Range(dbRange)
        Else
            Set unionRange = Union(unionRange, Range(dbRange))
        End If
    Next
End If
Next

unionRange.Copy Destination:=Range("G2") 'copy all received ranges to G2

Set dbDict = Nothing

The line "NumRowsDB = ThisWorkbook.Worksheets(Worksheets.Count).Range("A2", Range("A2").End(xlDown)).Rows.Count" is not working. I have to refer to another sheet (the last sheet which is the current database) to get the data. What is the problem that I cannot refer to another sheet in the same workbook?

Thank you for your suggestions.

用于过滤，复制和过去的数组 - 快速宏方法

2 个答案: