列の条件に基づいて複数の範囲を作成する

Question

VBAの新機能で、列内の条件に基づいて複数の範囲または配列を作成しようとしている場合は、それらを別のワークシートに配置します。問題は、このコードがいくつかの異なるデータセットに対して機能しなければならないことです。従って、1つのデータは thisのように見えますが、はるかに多くのデータポイント（データセットごとに約10,000）があります。

私がやっていることは、状態列の1の各グループについて、範囲/配列を作成してから、対応する時間とデータを新しいワークシートに移動することです。したがって、私が持っている例では、最初の新しいワークシートに範囲（「A2：B5」）、2番目の範囲（A10：B12）を含む3つの新しいワークシートがあります。各データセットで状態列が変化し、新しいワークシートの数も変化する可能性があります。

私はこのサイトを調べましたが、私のニーズに最も近いのはCreating Dynamic Range based on cell valueですが、既知の範囲の数があります。私はかなり正直なところ、私が必要とするものを達成する方法を知らない。私はwhileループの内側にifループを作成しようとしていましたが、それぞれのループでは動作しません。

ご協力いただければ幸いです！今数時間頭を叩いていた。

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