VBA将数组传输到工作表

Posted 2023-04-13

【中文标题】VBA将数组传输到工作表

【英文标题】：VBA Transferring array to a sheet

【发布时间】：2017-09-07 19:12:36

【问题描述】：

我得到了一个

运行时错误“1004”：应用程序定义或对象定义错误

以下是相关代码行：

ReDim checkedArr(1 To nKeeps, 1 To nCols) As Variant
' A couple loops between here
Worksheets(sheet + "_tmp").Range("A1").Resize(UBound(checkedArr, 1), UBound(checkedArr, 2)).value = checkedArr

我认为我在做一些微妙的不正确的事情，但我无法确切地弄清楚问题可能是什么。 VB 在上面的代码 sn-p 中不断自动将我的“.Value”更改为“.value”，我不确定为什么，但似乎它可能没有将其识别为正确的 Range 对象。

我尝试过明确声明一个范围：

Dim dest As Range
Set dest = Worksheets(sheet + "_tmp").Range("A1").Resize(UBound(checkedArr, 1), UBound(checkedArr, 2))
dest.value = checkedArr

但这会返回相同的问题。

在 Watch 中，checkedArr 的类型是 Variant/Variant(1 到 17, 1 到 41)，而 dest 的类型是 Range/Range。当我展开 dest（单击手表中的 +）时，它甚至没有 .Value 属性！有一个 Variant/Variant（1 到 17、1 到 41）类型的 Value2 属性，但尝试使用它也不起作用（给出相同的错误）。

谁能帮我理解我的缺陷？

编辑：

如果有人认为问题可能出在身体的其他部位，这里就是整个潜艇。

Sub findMatches(sheet As String)

Worksheets(sheet).Activate
Dim dataArr() As Variant
dataArr = Worksheets(sheet).Range("A1").CurrentRegion.value

Dim nRows As Long, nCols As Long, nKeeps As Long, mcvCol As Long
Dim row As Integer, col As Integer, eqCrit As Boolean
nRows = UBound(dataArr, 1)
nCols = UBound(dataArr, 2)
mcvCol = getColNum("MC Value", sheet)

' matchStatus(i) will be:
' -2 for matched rules
' -1 for the header
' 1 for an orphan
' 2 for an MC Value mismatch
ReDim matchStatus(1 To nRows) As Integer
matchStatus(1) = -1
nKeeps = 1
matchStatus(nRows) = 1

For row = 2 To nRows - 1
    If matchStatus(row) = 0 Then
        eqCrit = True
        For col = 9 To nCols
            eqCrit = eqCrit And (dataArr(row, col) = dataArr(row + 1, col))
        Next col
        If eqCrit Then
            If dataArr(row, mcvCol) = dataArr(row + 1, mcvCol) Then
                matchStatus(row) = -2
                matchStatus(row + 1) = -2
            Else
                matchStatus(row) = 2
                matchStatus(row + 1) = 2
                nKeeps = nKeeps + 2
            End If
        Else
            matchStatus(row) = 1
            nKeeps = nKeeps + 1
        End If
    End If
Next row
If matchStatus(nRows) = 1 Then
    nKeeps = nKeeps + 1
End If

ReDim checkedArr(1 To nKeeps, 1 To nCols) As Variant
Dim keepIdx As Long
keepIdx = 1
For row = 1 To nRows
    If matchStatus(row) > -2 Then
        checkedArr(keepIdx, 1) = matchStatus(row)
        For col = 2 To nCols
            checkedArr(keepIdx, col) = dataArr(row, col)
        Next col
        keepIdx = keepIdx + 1
    End If
Next row

Application.DisplayAlerts = False
Worksheets(sheet).Delete
Application.DisplayAlerts = True

Sheets.Add.Name = sheet + "_tmp"
Dim dest As Range
'Set dest = Worksheets(sheet + "_tmp").Range("A1:" + Split(Cells(, nCols).Address, "$")(1) + CStr(nKeeps))

Set dest = Worksheets(sheet + "_tmp").Range("A1").Resize(UBound(checkedArr, 1), UBound(checkedArr, 2))
dest.value = checkedArr

'Set dest = Worksheets(sheet + "_tmp").Range("A1")
'dest.Resize(UBound(checkedArr, 1), UBound(checkedArr, 2)) = checkedArr
'Worksheets(sheet + "_tmp").Range("A1:" + Split(Cells(, nCols).Address, "$")(1) + CStr(nKeeps)) = checkedArr

结束子

【问题讨论】：

有一个ReDim 语句直接在 将数组加载到一个范围对我来说似乎很可疑。如果数组未加载任何内容，则无法将数组加载到范围。

在第二个示例中，当您从数组中分配值时，您没有使用dest。任何合并的单元格，工作表保护？

@ScottHoltzman - 我在准备和加载数据之间有几个循环，但请放心，我正在尝试加载它不是空的。如果可能有帮助，我可以发布中间代码，但为了清楚起见，我最初将其省略了。

@TimWilliams 我的错误，我复制了错误的行。我会解决的 - 谢谢！

FWIW - Value 变成 value 通常是由于项目中某处有一些变量名为 value。然后，VBE 会在看到它使用时尝试保留大小写。

【参考方案1】：

我将您的代码“改写”为“测试”子程序。看一看。希望对您有所帮助。

    Sub test()

        Dim nKeeps As Integer, nCols As Integer

        nKeeps = 3
        nCols = 4


        ReDim ar(1 To nKeeps, 1 To nCols) As Variant

        For nKeeps = 1 To 3
            For nCols = 1 To 4
                ar(nKeeps, nCols) = nKeeps * nCols
            Next nCols
        Next nKeeps

        Dim ws As Worksheet
        Dim rng As Range

        Set ws = Worksheets("Sheet1")
        Set rng = ws.Range("A1")
        rng.Resize(nKeeps - 1, nCols - 1) = ar

    End Sub

【讨论】：

谢谢 - 我运行了那个确切的程序并且它工作了......但是我仍然无法让我的主程序工作。这至少可以给我一个调试的起点。

我终于找到了我的问题——在某些情况下，我的数组中有一些以等号开头的字符串。我只希望 VBA 有更详细的错误消息。