如何根据条件将Excel行的内容放入数组

Question

I have an excel sheet that I need to loop through each row and if it meets certain criteria, the data is placed into one of several different arrays. The number of rows are dynamic. I am encountering some issues with declaring the length of the arrays. I CAN simply loop through the rows, check the conditions I want and keep a running total of how many rows fit condition A, condition B, or condition C and use that to redim the arrays, but is there an easier way?

Thanks!

Answer 1

You do not tell us about your "issues with declaring the length of the arrays." My guess is that you are loading the arrays from a range which means that the row is the first dimension which you cannot change with ReDim.

I offer two approaches below based on my guess. Come back with a fuller explanation if neither of these approaches is helpful.

Approach 1

Load the entire range to a single array and then use a second array to record the type.

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

Approach 2

A jagged array might be more what you are after.

I set up Sheet1 to look like this:

I ran the macro below which first classifies each row and places it in the appropriate array. It then outputs each array to the immediate window to give:

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