VBA将数组传输到工作表

Question

我得到一个

运行时错误“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 在上面的代码片段中不断自动将我的“.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 (单击 watch 中的 + )时，它甚至没有 .Value 属性!有一个 Variant/Variant(1 到 17、1 到 41)类型的 Value2 属性，但尝试使用它也不起作用(给出相同的错误)。

有人可以帮我理解我的缺陷吗？

编辑:

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

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

结束子

Answer 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