Question

VBA新手，我正在尝试根据列中的条件创建多个范围或数组，然后将它们放在单独的工作表中。问题是此代码必须适用于多个不同的数据集。所以坐在一个数据看起来就像 this，但有更多的数据点（每个数据集大约10,000个）。

所以我要做的是，对于状态列中的每个1组，创建一个范围/数组，然后在新工作表中移动相应的时间和数据。因此，对于我的示例，将有3个新工作表，第一个新工作表包含范围（“A2：B5”），第二个包含范围（“A10：B12”）。对于每个数据集，状态列都会更改，新工作表的数量也会发生变化。

我查看了这个网站，我找到的最接近我的需求是Creating Dynamic Range based on cell value，但它有已知的范围数。老实说，我不知道如何完成我需要的东西。我一直在尝试在每个循环内部的if循环内部进行while循环，但是无法使其工作。

任何帮助将不胜感激！几个小时以来一直在敲我的脑袋。

Answer 1

这应该可以帮到你：

Option Explicit

Sub main()
    Dim area As Range

    With Sheets("myDataSheet") '<--| reference your sheet (change "myDataSheet") to your actual sheet name
        With .Range("C1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:C range form row 1 down to last column A not empty row
            .AutoFilter Field:=3, Criteria1:="1" '<--| filter referenced range on its 3rd column (i.e. "State") with 1
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filterd cells other than header
                For Each area In .Resize(.Rows.Count - 1, 2).Offset(1).SpecialCells(xlCellTypeVisible).Areas '<--| loop through filtered range (skipping header) 'Areas'
                    area.Copy Sheets.Add(Sheets(Sheets.Count)).Range("A1") '<--| copy current 'Area' into new sheet
                Next area
            End If
        End With
        .AutoFilterMode = False
    End With
End Sub

根据列中的条件创建多个范围

1 个答案: