时间戳

首页 > 解决方案 > 根据标准创建动态数组并粘贴到工作表

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

问题描述

源工作簿有一个包含 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

标签： arraysexcelvba

解决方案

在没有看到工作簿的情况下，我不能 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

推荐阅读