如何根據條件將Excel行的內容放入數組

Question

我有一張Excel表格，需要遍歷每一行，如果符合特定條件，則將數據放入幾個不同的數組中的一箇中。行數是動態的。我遇到了一些關於聲明數組長度的問題。我可以簡單地遍歷行，檢查我想要的條件，並保持總共有多少行符合條件A，條件B或條件C，並使用它來重新設置數組，但有沒有更簡單的方法？

謝謝！

Answer 1

您不會告訴我們關於「聲明數組長度的問題」。我的猜測是，您正在從一個範圍加載數組，這意味着該行是您無法使用ReDim更改的第一個維度。

根據我的猜測，我提供了兩種方法。如果這兩種方法都沒有幫助，請回答一個更全面的解釋。

方法1個

負荷的整個範圍內，以一個單一的陣列，然後使用第二陣列來記錄的類型。

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