Question

不得不创建一个新的主题，前一个很老（当时没有时间处理案例）。

我有19列的数据。日期，名称，数量，各种数字的13列，公司，位置，对象。到目前为止，我已设法提取唯一的公司/位置名称，并将它们放在一个单独的表格中。

我需要的另一件事是根据公司/位置复制整行（或多行记录的行）。我已经设法通过自动过滤使用1个参数使其工作，但它不适用于2。如果我将Company设置为第一个变量而将Location设置为2nd，我就不知道如何运行一个同时更改两个变量的循环。循环内的循环不起作用，因为内部循环将更快地耗尽参数。

    Sub Zaloz_Arkusze()

    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    Dim wbk3 As Workbook
    Dim wbk4 As Workbook
    Dim LW As Long
    Dim LR As Long
    Dim i As Integer
    Dim j As Integer
    Dim test As Integer
    Dim test2 As Integer
    Dim Rng As Range, rCell As Range, MyTable As Range, MyTable2 As Range
    i = 1
    j = 4

    'Optimize Macro Speed
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.DisplayAlerts = False
      Application.Calculation = xlCalculationManual

    Set wbk3 = ActiveWorkbook
    Set wbk4 = Workbooks.Open("C:\Users\rzakrzewski\Desktop\Przeroby.xlsm")

    wbk3.Sheets(2).Activate
    Set Rng = wbk3.Sheets(2).Range("A1", Range("R" & Rows.Count).End(xlUp))

    LR = Sheets(2).Cells(Rows.Count, "S").End(xlUp).Row
         Sheets(2).Range("Q1:R" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(4).Range("A1"), Unique:=True
    LW = Sheets(4).Range("B1", Sheets(4).Range("B1").End(xlDown)).Rows.Count

    Sheets(4).Activate
    Set MyTable = wbk3.Sheets(4).Range("B1", Range("B1").End(xlDown))
    Set MyTable2 = wbk3.Sheets(4).Range("A1", Range("A1").End(xlDown))

    test = MyTable.Rows.Count
    test2 = MyTable2.Rows.Count

    wbk3.Sheets(2).Activate

    For Each rCell In MyTable
    On Error Resume Next
        wbk4.Activate
        wbk4.Worksheets.Add(After:=Sheets(Worksheets.Count)).Name = i
        wbk3.Sheets(2).Activate
         With Rng
            .AutoFilter , Field:=18, Criteria1:=rCell.Value
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                wbk4.Sheets(j).Range("A" & Rows.Count).End(xlUp).Offset(1)
            .AutoFilter
        End With
    On Error GoTo 0
    i = i + 1
    j = j + 1

Next rCell

    Application.EnableEvents = True

End Sub

以上还根据唯一记录的数量添加了新的工作表，并复制了我需要的数据。 MyTable2参数未使用couse我不知道如何使用它。

我想知道使用2d阵列，但我从未使用它们，我甚至不知道如何开始。

按2个值排序数据

0 个答案: