Excel VBA-根據條件從范圍到數組插入行； 然后使用數組中的數據填充另一張紙上的某些范圍

Question

我的VBA知識非常有限。 我瀏覽了StackOverflow上的問題，然后用谷歌搜索了幾天，但是找不到解決我問題的方法。

因此，我正在處理Excel宏。 我的范圍是A3：H7136。 A列中的某些單元格的值為1； 其余為空。 D，E，F，G，H列中的單元格可以為空白，也可以包含文本或數字。

我正在嘗試做的是將范圍A3：H7136並將數據放入數組中。 排除包含空白A單元格和空白D單元格的行； 轉換為“最終”數組，將第2、4和8列中的數據粘貼到另一個工作表上的范圍D309：D558，G309：G558，J309：J558中。

到目前為止，我有以下幾點：

Private Sub CommandButton1_Click()
Dim RowArray() As Long
Dim my_array1 As Range
Dim my_array2 As Variant
Dim i As Integer

Set my_array1 = ThisWorkbook.Worksheets("ETC").Range("A3:H7136")
my_array2 = my_array1.Value

For i = 1 To UBound(my_array2)
    If my_array2(i, 1) = 1 And my_array2(i, 4) <> "" Then
        RowArray(x) = i: x = x + 1
    End If
Next i

Sheets("Allocation").Range("D309:D558") = Application.Index(my_array2, 1, Array(4))
Sheets("Allocation").Range("J309:J558") = Application.Index(my_array2, 1, Array(2))
End Sub

我停在那里，因為我意識到代碼粘貼了#value！ 進入另一個工作表中的范圍。 該代碼是來自多個論壇的“ Frankenstein-ed”，因此對於專業人士而言可能看起來很奇怪。 我需要幫助使代碼正常工作。 我也有幾個問題：

1. 如果“最終”數組為100％空白（可能會發生），我該如何擺脫#Value！ 在另一個工作表上？
2. 在最后兩行中，我看起來好像在使用原始的my-array2 ，而不是它的“最終”過濾版本。 我應該聲明“最終”數組嗎？
3. 我的粘貼范圍只有250行； 數組中非空白行的數量不可能超過250行，但是，這種差異會成為問題嗎？

提前致謝！

Answer 1

幾件事：

從來沒有聲明過RowArray的大小，因此會拋出界外錯誤。

您可以將三個數組用於循環中的輸出，然后將數組直接分配給所需的區域。

Private Sub CommandButton1_Click()
Dim DArray() As Variant
Dim GArray() As Variant
Dim JArray() As Variant

Dim my_array2 As Variant
Dim i As Long, x As Long
Dim cnt As Long

cnt = ThisWorkbook.Worksheets("ETC").Evaluate("COUNTIFS(A3:A7136,1,D3:D7136,""<>"")")
If cnt > 0 Then
    ReDim DArray(1 To cnt, 1 To 1) As Variant
    ReDim GArray(1 To cnt, 1 To 1) As Variant
    ReDim JArray(1 To cnt, 1 To 1) As Variant

    my_array2 = ThisWorkbook.Worksheets("ETC").Range("A3:H7136").Value
    x = 1
    For i = 1 To UBound(my_array2)
        If my_array2(i, 1) = 1 And my_array2(i, 4) <> "" Then
            DArray(x, 1) = my_array2(i, 4)
            GArray(x, 1) = my_array2(i, 4)
            JArray(x, 1) = my_array2(i, 8)
            x = x + 1
        End If
    Next i

    Sheets("Allocation").Range("D309").Resize(UBound(DArray, 1), 1).Value = DArray
    Sheets("Allocation").Range("G309").Resize(UBound(GArray, 1), 1).Value = GArray
    Sheets("Allocation").Range("J309").Resize(UBound(JArray, 1), 1).Value = JArray
End If
End Sub