各行をループする必要がある Excel シートがあり、特定の基準を満たす場合、データはいくつかの異なる配列の 1 つに配置されます。行数は動的です。配列の長さを宣言する際に問題が発生しています。行をループして、必要な条件を確認し、条件 A、条件 B、または条件 C に適合する行の現在の合計数を保持し、それを使用して配列を再調整することができますが、もっと簡単な方法はありますか?
ありがとう!
「配列の長さを宣言する際の問題」については教えてくれません。私の推測では、範囲から配列を読み込んでいるということです。これは、行が ReDim で変更できない最初の次元であることを意味します。
私の推測に基づいて、以下に2つのアプローチを提供します。これらのアプローチのどちらも役に立たない場合は、より完全な説明をしてください。
アプローチ1
範囲全体を単一の配列にロードしてから、2 番目の配列を使用して型を記録します。
Dim AllTypes() As Variant
Dim RowCrnt As Long
Dim RowType() As Long
AllTypes = EntireRange.Value
Redim RowType(LBound(AllTypes,1) TO UBound(AllTypes,1))
For RowCrnt = LBound(AllTypes,1) TO UBound(AllTypes,1)
' Classify Row
RowType(RowCrnt) = X
Next
アプローチ 2
ギザギザの配列は、あなたが求めているものよりも多いかもしれません。
Sheet1 を次のように設定します。
以下のマクロを実行して、最初に各行を分類し、適切な配列に配置しました。次に、各配列を即時ウィンドウに出力して、次のようにします。
a b c d e f g h i j
b c d e f g h i j k
c d e f g h i j k l
a b c d e f g h i j
b c d e f g h i j k
c d e f g h i j k l
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
a 1 b 2 c 3
b 2 c 3 d 4
c 3 d 4 e 5
a 1 b 2 c 3
b 2 c 3 d 4
c 3 d 4 e 5
Sub Test3()
Dim ColCrnt As Long
Dim InxTypeACrnt As Long
Dim InxTypeACrntMax As Long
Dim InxTypeBCrnt As Long
Dim InxTypeBCrntMax As Long
Dim InxTypeCCrnt As Long
Dim InxTypeCCrntMax As Long
Dim RowCrnt As Long
Dim RowLast As Long
Dim TypeA() As Variant
Dim TypeB() As Variant
Dim TypeC() As Variant
ReDim TypeA(1 To 2) ' Change 2 to something sensible
ReDim TypeB(1 To 2)
ReDim TypeC(1 To 2)
InxTypeACrntMax = 0
InxTypeBCrntMax = 0
InxTypeCCrntMax = 0
With Worksheets("Sheet1")
RowLast = .Cells(Rows.Count, "A").End(xlUp).Row
' Load each row to the appropriate array
For RowCrnt = 1 To RowLast
If IsNumeric(.Cells(RowCrnt, "A").Value) Then
' Type B. Five numbers
InxTypeBCrntMax = InxTypeBCrntMax + 1
If InxTypeBCrntMax > UBound(TypeB) Then
' Array B full. Resize
ReDim Preserve TypeB(1 To UBound(TypeB) + 2)
End If
TypeB(InxTypeBCrntMax) = _
.Range(.Cells(RowCrnt, 1), .Cells(RowCrnt, 5)).Value
ElseIf IsNumeric(.Cells(RowCrnt, "B").Value) Then
' Type C. Six values, mixed alpha and numeric
InxTypeCCrntMax = InxTypeCCrntMax + 1
If InxTypeCCrntMax > UBound(TypeC) Then
' Array C full. Resize
ReDim Preserve TypeC(1 To UBound(TypeC) + 2)
End If
TypeC(InxTypeCCrntMax) = _
.Range(.Cells(RowCrnt, 1), .Cells(RowCrnt, 6)).Value
Else
' Type A. Ten strings
InxTypeACrntMax = InxTypeACrntMax + 1
If InxTypeACrntMax > UBound(TypeA) Then
' Array A full. Resize
ReDim Preserve TypeA(1 To UBound(TypeA) + 2)
End If
TypeA(InxTypeACrntMax) = _
.Range(.Cells(RowCrnt, 1), .Cells(RowCrnt, 10)).Value
End If
Next
End With
' Display contents of each array
For InxTypeACrnt = 1 To InxTypeACrntMax
For ColCrnt = 1 To 10
' Each element of array TypeA is now a 2D array of size (1 To 1, 1 To 10)
' Note how I access the cells of the inner array
Debug.Print TypeA(InxTypeACrnt)(1, ColCrnt) & " ";
Next
Debug.Print
Next
For InxTypeBCrnt = 1 To InxTypeBCrntMax
For ColCrnt = 1 To 5
Debug.Print TypeB(InxTypeBCrnt)(1, ColCrnt) & " ";
Next
Debug.Print
Next
For InxTypeCCrnt = 1 To InxTypeCCrntMax
For ColCrnt = 1 To 6
Debug.Print TypeC(InxTypeCCrnt)(1, ColCrnt) & " ";
Next
Debug.Print
Next
End Sub