VBA陣列轉移到片材

運行時錯誤「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是Type Variant/Variant（1到17,1到41），dest是Range/Range類型。當我展開dest（點擊手錶中的+）時，它甚至沒有.Value屬性！ Value2屬性的類型爲Variant/Variant（1到17,1到41），但嘗試使用它也不起作用（給出相同的錯誤）。

有人能幫我理解我的缺陷嗎？

編輯：

這裏就是整個子，如果有人認爲，問題可能是在身體的其他部位。

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

末次

來源

2017-09-07 Nitin

在將一個數組加載到一個範圍之前有一個'ReDim'語句*對我來說似乎很詭異。如果數組未裝載任何內容，則無法將數組加載到範圍內。 –

在你的第二個例子中，當你從數組中分配值時，你沒有使用'dest'。任何合併的單元格，表格保護？ –

@ScottHoltzman - 在準備和加載數據之間有一對循環，但請放心，我試圖加載它。如果可以幫助，我可以發佈中間代碼，但爲了清楚起見，我最初將其留在了原位。 – Nitin

我「改寫」您的代碼以 '測試' 子。看一看。希望能幫助到你。

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

來源

2017-09-07 19:40:03 Felix

謝謝 - 我運行了這個確切的程序，它工作...但是我仍然無法讓我的主程序正常工作。這至少可以給我一個調試的起點。 – Nitin

我終於想通了我的問題 - 在某些情況下，我的數組有一些以等號開頭的字符串。我只希望VBA有更詳細的錯誤消息。 – Nitin

VBA陣列轉移到片材

回答

相關問題