根据标准创建动态数组并粘贴到工作表

Question

源工作簿有一个包含 32 列的工作表，并且行数是动态的。将有一个值为“Y”或“N”的列。对于每个“Y”，我需要将该行写入一个数组，甚至是空单元格。列标题开始是单元格“A6”和“A7”的详细信息。

下一步将数组粘贴到不同工作表中的实际表中。这将定期发生，并且当用户更新源时需要替换表中的值。

1. 从源创建数组
2. 清除目标工作表中的表格
3. 将数组粘贴到目标工作表的表格中

问题是我在数组中没有得到任何值，而且我仍在尝试总体上掌握数组，因此我们将不胜感激。下面的代码来自我为测试目的而进行的一小部分代码。

    Sub CopyToDataset()


    Dim datasetWs As Worksheet
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim cell As Range, rng1 As Range, rng2 As Range, row As Range
    Dim ArrayofAJobs() As Variant
    Dim ArrayofACCJobs() As Variant
    Dim myData As Range
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim LastRowWs1 As Long
    Dim LastRowWs2 As Long

    Set ws1 = ThisWorkbook.Worksheets("Src")
     ' Find the last row with data.
    LastRowWs1 = LastRow(ws1)


    k = 1
    With ws1
    ReDim ArrayofAJobs(6, k)
    For i = 2 To LastRowWs1
    If UCase(Cells(i, 1)) = "Y" Then
        For j = 2 To 4
            If IsNull(ArrayofAJobs(j, k)) Then ArrayofAJobs(j, k) = vbNullString
            ArrayofAJobs(j, k) = Cells(i, j).Value
        Next j
        k = k + 1
        ReDim Preserve ArrayofAJobs(4, k)
    End If
    Next i
    End With


    ArrayofAJobs() = TransposeArray(ArrayofAJobs)

    With ThisWorkbook.Worksheets("Dest")
        .Range("A6") = ArrayofAJobs()
    End With
End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).row
    On Error GoTo 0
End Function


Public Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
    Xupper = UBound(myarray, 2)
    Yupper = UBound(myarray, 1)
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = myarray(Y, X)
        Next Y
    Next X
    TransposeArray = tempArray
End Function

================================================ =====================

版本 2：运行时错误 9：下标超出范围。

样本来源：

Option Explicit
Option Base 1

Sub CopyToDataset()

 Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim destWkb As Workbook
    Dim cell As Range, rng1 As Range, rng2 As Range, row As Range
    Dim ArrayofAJobs() As Variant
    Dim ArrayofACCJobs() As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim LastRowWs1 As Long
    Dim LastRowWs2 As Long
    k = 1
    Const startRow As Long = 6


    Set ws1 = ThisWorkbook.Worksheets("Src")

     ' Find the last row with data on ws1.
    LastRowWs1 = LastRow(ws1)
    Debug.Print LastRowWs1


    With ws1
    ReDim ArrayofAJobs(i, 32)
    For i = 1 + startRow To LastRowWs1 'Number of rows starting at row 6. Details start on row 7.
    If UCase(.Cells(i, 1)) = "Y" Then
        For j = 1 To 32 'Number of columns starting on column A
            If IsNull(ArrayofAJobs(i, j)) Then ArrayofAJobs(i, j) = vbNullString
            ArrayofAJobs(i, j) = .Cells(i, j).Value
        Next j
    End If
    Next i
    End With

    With ThisWorkbook.Worksheets("Dest")
        .Range(.Cells(2, 1), .Cells(UBound(ArrayofAJobs, 1), UBound(ArrayofAJobs, 2))) = ArrayofAJobs()
    End With
End Sub

Answer 1

在没有看到工作簿的情况下，我不能 100% 确定我完全按照您的要求进行操作，但我确实看到了一些我会改变的事情。

1. 您需要添加一个“。”在Cells 之前。该点可确保您选取的单元格来自 ws1 而不是活动工作表。

   If UCase(.Cells(i, 1)) = "Y" Then    
   
       ArrayofAJobs(j, k) = .Cells(i, j).Value
   

2. 监视窗口没有展开任何数组元素，所以我们看不到数组实际上是空的。但是，您不能Redim Preserve 数组的第一个维度。

   ReDim ArrayofAJobs(6, k)
   
   ReDim Preserve ArrayofAJobs(4, k)   'This line should cause a Runtime Error 9.
   

   您似乎需要将第一个 ReDim 更改为 ArrayofAJobs(**4**, k)。

3. 当您“粘贴”一个数组时，您必须指定将要“粘贴”到的整个范围。这不像粘贴一系列复制的单元格，您可以在其中告诉 Excel 顶部、左侧的单元格，然后它会计算出其余的单元格。所以你需要改变你的代码

   .Range("A6") = ArrayofAJobs()
   

   到这个。

   .Range(.Cells(6, 1), .Cells(UBound(ArrayofAJobs, 1), UBound(ArrayofAJobs, 2))) = ArrayofAJobs