Блог

У меня есть набор данных из базы данных, импортированных в файл 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
  

Не удалось протестировать это, но я думаю, что это должно работать, по крайней мере, до части разделения (если что-то пойдет не так, вы могли бы найти другой способ или просто использовать опцию интерфейса для преобразования текста в столбцы):

 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) amp; "-" amp; arrData(i, 2)) Then
            DictColD.Add arrData(i, 1) amp; "-" amp; 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) amp; "-" amp; arrData(i, 2)) = DictColD(arrData(i, 1) amp; "-" amp; 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) amp; "-" amp; arrData(i, 2)) Then
            DictColE.Add arrData(i, 1) amp; "-" amp; 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) amp; "-" amp; arrData(i, 2)) = DictColE(arrData(i, 1) amp; "-" amp; 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 amp; 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 amp; 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
  

Это должно быть довольно быстрее, чем ваш фактический код, поскольку он обрабатывает все в памяти.