双循环自动过滤器，在Excel VBA中有效吗？

Question

我从导入Excel文件的数据库中获取了一组数据。该数据来自用于金属的激光切割机。我的数据包括材料名称，板材厚度和2个不同的时间（有更多的数据，但那4个是我需要的）。

我想要的结果：我想首先在材料名称上过滤我的数据，之后我想过滤我的板材厚度数据。在第二个过滤器的结果中，我希望将两个时间段的时间相加，然后将结果发布在另一个表中。因此，第二张表中的结果应为：材料名称，印版厚度，D列结果的总时间，E列结果的总时间（其他列中的某些数据与此无关）

以下是数据外观的一个小例子（数据从第3行开始）：

Material name(col A)Plate Thickness(col B)Time1(col D)Time2(col E)
RVS 304             25mm                  00:18:14    00:21:48
RVS 304             25mm                  00:30:28    00:39:19
RVS 304             10mm                  00:12:10    00:14:25
S235                10mm                  00:48:32    00:13:33
S235                3mm                   00:10:31    00:02:22

其他一些有用的信息：我的循环基于的材质名称基于我的结果并按重复进行过滤，因此材质名称始终存在。板材厚度具有标准数量的项目，该范围内的项目数量为19个不同的尺寸，以毫米为单位。我的过滤条件列表从单元格2开始，这就是整数从2开始的原因。两个自动过滤器的结果都不会产生任何结果，因为不是每个材料名称都完成了每个板厚度。

在我当前的代码上添加一些内容：它几乎可以完成这项工作，它会在循环中通过材料名称列表跳过某些项目而无法总结时间。它也非常慢，所以我想知道我是否可以让它运行得更快。

这是我的代码：

Sub TestSub()
On Error Resume Next
    Worksheets("InformatieData").ShowAllData
On Error GoTo 0
Dim iLoop As Integer

For iLoop = 1 To 20

Worksheets("InformatieData").Range("A2").AutoFilter Field:=1, Criteria1:=Worksheets("InformatieFormules").Cells(iLoop, 1).Value
If Worksheets("InformatieData").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
    Dim mmLoop As Integer

    For mmLoop = 2 To 20
        Worksheets("InformatieData").Range("A2").AutoFilter Field:=2, Criteria1:=Worksheets("InformatieFormules").Cells(mmLoop, 2).Value
        If Worksheets("InformatieData").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            Worksheets("InformatieData").Range("A3:A10000,B3:B10000,D3:D10000,E3:E10000").Copy
            Worksheets("InformatieMMFilterResultaat").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
        End If
    Next mmLoop
End If
Next iLoop
End Sub

Answer 1

无法测试这个，但我认为它应该工作，至少在分裂部分之前（如果出现问题你可以找到另一种方法，或者只是使用texto的接口选项到列）：

Option Explicit
Sub Test()

    Dim wsData  As Worksheet, wsOutput As Worksheet, arrData As Variant, SplitRange As Range, i As Long
    'You will need to check Microsoft Scripting Dictionary from your references for this to work:
    Dim DictColD As New Scripting.Dictionary, DictColE As New Scripting.Dictionary

    'Set the worksheets where we will work
    With ThisWorkbook
        Set wsData = .Sheets("InformatieData")
        Set wsOutput = .Sheets("InformatieMMFilterResultaat")
    End With

    'Fill an array with the source data
    arrData = wsData.UsedRange.Value 'this will get everything on the worksheet till the last used cell

    'Lets assume, as you said that the order and position of the columns is A to E
    For i = 2 To UBound(arrData) '2 because 1 is headers
        'if the material with the thickness doesn't exist yet, add it along with its time on column D
        If Not DictColD.Exists(arrData(i, 1) & "-" & arrData(i, 2)) Then
            DictColD.Add arrData(i, 1) & "-" & arrData(i, 2), arrData(i, 4) 'Column D value
        Else
        'If the material with the thickness already exists, then sum its time on column D
            DictColD(arrData(i, 1) & "-" & arrData(i, 2)) = DictColD(arrData(i, 1) & "-" & arrData(i, 2)) + arrData(i, 4)
        End If

        'Now the same for column E
        'if the material with the thickness doesn't exist yet, add it along with its time on column E
        If Not DictColE.Exists(arrData(i, 1) & "-" & arrData(i, 2)) Then
            DictColE.Add arrData(i, 1) & "-" & arrData(i, 2), arrData(i, 5) 'Column E value
        Else
        'If the material with the thickness already exists, then sum its time on column E
            DictColE(arrData(i, 1) & "-" & arrData(i, 2)) = DictColE(arrData(i, 1) & "-" & arrData(i, 2)) + arrData(i, 5)
        End If
    Next i

    Erase arrData

    'Now you've got 2 dictionaries along with all the data you need, you only need to throw it back to your sheet
    With wsOutput 'I'm going to assume you already have the headers there so only the data will be pasted
        .Cells(2, 1).Resize(DictColD.Count) = Application.Transpose(DictColD.Keys) 'Material & Thickness
        .Cells(2, 4).Resize(DictColD.Count) = Application.Transpose(DictColD.Items) 'Col D Times
        .Cells(2, 5).Resize(DictColE.Count) = Application.Transpose(DictColE.Items) 'Col E Times
        'Now we need to separate material & thickness into 2 columns
        Set SplitRange = .Range("A2", .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
        SplitRange.TextToColumns Destination:=SplitRange, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End With

End Sub

这应该比你的实际代码快得多，因为它在内存上运行一切。