0

各行をループする必要がある Excel シートがあり、特定の基準を満たす場合、データはいくつかの異なる配列の 1 つに配置されます。行数は動的です。配列の長さを宣言する際に問題が発生しています。行をループして、必要な条件を確認し、条件 A、条件 B、または条件 C に適合する行の現在の合計数を保持し、それを使用して配列を再調整することができますが、もっと簡単な方法はありますか?

ありがとう！

4

1 に答える 1

0

「配列の長さを宣言する際の問題」については教えてくれません。私の推測では、範囲から配列を読み込んでいるということです。これは、行が 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
于 2012-05-19T11:09:53.127 に答える