VBA從數組中填充範圍

我創建了一個數組，該數組在滿足條件時填充 - 迄今爲止這麼好。現在符合條件的值需要複製到不同的工作表。VBA從數組中填充範圍

其實我不得不提問： 1.我無法獲得範圍內的值在第一位。 2.如果滿足條件，數組將存儲每行的4列（範圍）。如果我可以確定每個數組列並將其粘貼到特定列（數組中的列彼此相鄰，但在目標表中它們不是），是否可能？

此代碼我到目前爲止：

Sub determineDelta() 
'Start determination and copy values to Delta sheet 
Worksheets("Source").Activate 
Range("A2").Select 
numberOfRecords = Range(Selection, Selection.End(xlDown)).Rows.Count + 1 

Dim myArray() As Variant 
ReDim myArray(1 To 500) As Variant 
Dim i, j, k As Integer 
k = 0 
ReDim myArray(numberOfRecords, k) As Variant 

    For i = 2 To numberOfRecords 
     If IsError(Application.Match(Cells(i, "A").Value, Sheets("SE16N").Range("A:A"), 0)) Then 
      For j = 2 To 6 
       myArray(j, k) = Cells(i, j).Value 
       Debug.Print myArray(j, k) 
      Next j 
      k = k + 1 
      ReDim Preserve myArray(numberOfRecords, k) 
     End If 
    Next i 

Worksheets("Delta").Activate 
Range("I2:I" & UBound(myArray)) = "FI" 
Range("J2:J" & UBound(myArray)) = "A" 
Range("M2").Resize(UBound(myArray), 1).Value = Application.Transpose(myArray) 
End Sub

我一直在尋找在互聯網上2天，包括cpearson。在這篇關於array sizing（底部）的文章中指出＃N/A。這就是我所擁有的！但不要。 :-)

我有這種感覺，我不是那麼遙遠，如果它只是一個相對較小的東西，不會感到驚訝。

我希望有人能幫助我。

來源

2017-10-11 Dennis

添加了一些建議，不知道這是否是你需要的。

Sub determineDelta() 
    'Start determination and copy values to Delta sheet 
    Worksheets("Source").Activate 
    Range("A2").Select 
    numberofrecords = Range(Selection, Selection.End(xlDown)).Rows.count + 1 

    Dim myArray() As Variant 
    'Unnecessary code 
    'ReDim myArray(1 To 500) As Variant 
    Dim i, j, k As Integer 
    k = 0 
    'ReDim myArray(numberOfRecords, k) As Variant 
    ReDim myArray(numberofrecords, 2 To 6) As Variant 

    For i = 2 To numberofrecords 
     '[1] 
     If Not IsError(Application.Match(Cells(i, "A").Value, Sheets("SE16N").Range("A:A"), 0)) Then 
      For j = 2 To 6 
       '[2] 
       'myArray(j, k) = Cells(i, j).Value 
       'Debug.Print myArray(j, k) 
       myArray(k, j) = Cells(i, j).Value 
      Next j 
      k = k + 1 
      'Since we already have a large enough array, no need to redim here 
      'ReDim Preserve myArray(numberofrecords, k) 
     End If 
    Next i 

    With Worksheets("Delta") 
     .Range("I2:I" & UBound(myArray)) = "FI" 
     .Range("J2:J" & UBound(myArray)) = "A" 
     '[3] 
     '.Range("M2").Resize(UBound(myArray), 1).Value = Application.Transpose(myArray) 
     .Range("M2").Resize(UBound(myArray), 5).Value = myArray 
    End With 
End Sub

[1]：如果在下述式中的錯誤 ISERROR將返回TRUE。如果在表格（「SE16N」）中找到單元格（i，「A」），它將不會進入for循環。因此，myArray將始終捕獲不在表格中的值（「SE16N」）。添加NOT運算符後，只能找到能夠加載到myArray中的項目。但是，如果您需要捕獲表格中未顯示的值（「SE16N」），則原點是正確的。

[2]：這是一個浪費，你聲稱一個數組約100行，但你只訪問行＃2到＃6。我將（j，k）改爲（k，j），所以希望大部分數組都可以使用。

[3]：由於我交換了行和列，數組不再需要轉置。在你原來的代碼中，調整範圍的大小會得到一個有幾行和一列的範圍。所以只有數組的第一列可以複製到工作表中，如果我錯了，可以隨意將5更改回1。

如果您需要將數據粘貼到分隔的列中，我會考慮兩種方法。 1.您可以在開始時將數據存儲到不同的數組中。 2.多次循環陣列，如：

Set OriginCell = Range("M2") 
Set OriginCell2 = Range("Q2") 
For i = 0 to UBound(myArray) 
    OriginCell.Offset(i).Value = myArray(i, 2) 
    OriginCell2.Offset(i).Value = myArray(i, 3) 
Next i

來源

2017-10-11 16:22:17 newacc2240

非常感謝。當我用你的評論改變上面的代碼時，它可以工作。 – Dennis

非常感謝。當我用你的評論改變上面的代碼時，它可以工作。 [1]是的，如果價值不存在，它需要做點什麼。所以我沒有改變那部分。 [2]我想我仍然需要閱讀更多關於數組的知識，因爲這對我來說不是100％清楚。 [3]太棒了。不知道這是可能的。

是的，數組中的列需要轉到單個列。我試着用你的代碼，但它沒有做到這一點。我明白你想要做的是什麼。但是，如果我這樣插入它，它將使用當前工作表即Source，而數據需要在工作表Delta中。

當我設置包含在工作表中的範圍功能，以及和它的作品般的魅力：

Set OriginCell = Worksheets("Delta).Range("M2") 
Set OriginCell2 = Worksheets("Delta).Range("Q2") 
For i = 0 to UBound(myArray) 
    OriginCell.Offset(i).Value = myArray(i, 2) 
    OriginCell2.Offset(i).Value = myArray(i, 3) 
Next i

只有陣列中的一些空行，但我將能夠管理自己。：）謝謝！

來源

2017-10-12 12:53:25 Dennis

VBA從數組中填充範圍

回答

相關問題