运行时错误“1004”：应用程序定义或对象定义的错误，重复使用 "range" 对象

Question

我正在尝试使用 VBA 制作一个自动模板，当我输入少量 "pages" 时，这段代码似乎运行良好，但当我输入诸如按照提示，它给我一个运行时错误 1004：14 页：41、26、19、28、26、28、17、26、21、19、19、10、23、28。

Public TitleSize As Integer
Public MostValves() As Integer
Public TotalValves As Integer
Public TitleBlockSize As Integer

Function ConvertToLetter(iCol As Integer) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function

Sub ManualValve()

'On Error GoTo ErrHandler
'On Error Resume Next

Worksheets(1).Activate
ActiveSheet.Name = "Valve List"
ActiveSheet.Cells.Clear

PnIDPage = InputBox("How many pages are on your P&ID?")
'Values for Number of Pages: 14

Dim i As Integer

TotalValves = 0

ReDim MostValves(PnIDPage)

For i = 0 To PnIDPage - 1

    ValveCount = InputBox("How many valves are on page " & i + 1 & " ?")
'Values for valves: 41, 26, 19, 28, 26, 28, 17, 26, 21, 19, 19, 10, 23, 28
    If IsNumeric(ValveCount) Then
        MostValves(i) = ValveCount
        TotalValves = TotalValves + ValveCount
    Else
        MsgBox ("You did not enter a valid number")
        'GoTo ErrHandler
    End If
Next i

Dim Title As Variant

Response = MsgBox(prompt:="Do you want to use the default titleblock? (Count, Valve, Module, Note)", Buttons:=vbYesNo)

If Response = vbYes Then
    Title = Array("Count", "Valve", "Module", "Note")
    TitleSize = UBound(Title, 1) - LBound(Title, 1) + 1
Else
    Title = Array("Count", "Valve", "Module")
    TitleSize1 = UBound(Title, 1) - LBound(Title, 1) + 1
    XtraCol = InputBox("How many extra columns would you like to add?")
    ReDim Preserve Title(XtraCol + TitleSize1 - 1)
    TitleSize = UBound(Title, 1) - LBound(Title, 1) + 1
        For i = TitleSize1 + 1 To TitleSize
            XtraTitle = InputBox("Extra Title " & i & "?")
            Title(i - 1) = XtraTitle
        Next i
End If

Dim TitleBlock As Variant

TitleBlock = Array("Project Number", "Project Name", "By", "Rev", "Date")
TitleBlockSize = UBound(TitleBlock, 1) - LBound(TitleBlock, 1) + 1
Range(ConvertToLetter(1) & "1:" & ConvertToLetter(1) & TitleBlockSize) = Application.Transpose(TitleBlock)

Dim Maximum As Integer
Dim ValveNum() As Integer
Dim TempSize As Integer

TempSize = 1
Maximum = WorksheetFunction.Max(MostValves) + 1

For i = 0 To PnIDPage - 1
    Do Until MostValves(i) <> 0
        i = i + 1
    Loop

    ReDim ValveNum(MostValves(i))

    For j = 0 To MostValves(i)
        ValveNum(j) = j + 1
    Next j
        MsgBox TempSize
        If i Mod 2 = 0 Then
            Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & Maximum + TitleBlockSize).Interior.ColorIndex = 42
        Else
'This is where I encounter the run-time error
            Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & Maximum + TitleBlockSize).Interior.ColorIndex = 43
        End If

        Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize) & CStr(MostValves(i) + 1 + TitleBlockSize)). _
        Resize(MostValves(i), 1) = Application.Transpose(ValveNum)
        Worksheets(1).Range(ConvertToLetter(TempSize + 2) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + 2) & CStr(MostValves(i) + 1 + TitleBlockSize)) = "00" & CStr(i + 1)
        Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & TitleBlockSize + 1) = Title
        TempSize = TempSize + TitleSize
        Worksheets(1).Range(ConvertToLetter(TempSize - 1) & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & Maximum + TitleBlockSize). _
        Borders(xlEdgeRight).Weight = xlMedium
    Next i

    Cells(1, 4) = "Total Valve Count"
    Cells(1, 5) = TotalValves
    Range("A1:" & ConvertToLetter(TempSize) & Maximum + TitleBlockSize).HorizontalAlignment = xlCenter
    Range("A1:A" & TitleBlockSize).HorizontalAlignment = xlLeft
    Columns("A:" & ConvertToLetter(TempSize)).AutoFit
    Range("A1:" & ConvertToLetter(TempSize) & TitleBlockSize + 1).Font.Bold = True
    Range("A" & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & TitleBlockSize + 1).Interior.ColorIndex = 1
    Range("A" & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & TitleBlockSize + 1).Font.Color = vbWhite
    Range("A" & Maximum + TitleBlockSize & ":" & ConvertToLetter(TempSize - 1) & Maximum + TitleBlockSize). _
        Borders(xlEdgeBottom).Weight = xlMedium

'ErrHandler:
    'MsgBox "An error has occurred. The macro will end."

End Sub

Answer 1

问题不在于您的 Valve，而在于您的 ConvertToLetter 函数。事实上，在某些时候会发生错误，因为函数 returns 一个无效的范围字母：

input: iCol = 53
return: "A["

显然，当您尝试调用 Range("A[2") 时，会引发异常。

你的函数中的代码不可靠，因为将数字转换为字母：

ConvertToLetter = Chr(iAlpha + 64)

Chr() 函数 returns 与字符集合中的索引关联的值，这是一个唯一的字符列表，不能像您尝试在那里那样使用。我会用更可靠的函数替换您的 ConvertToLetter 函数，例如：

Function ConvertToLetter(iCol As Integer) As String
    Dim vArr
    vArr = Split(Cells(1, iCol).Address(True, False), "$")
    ConvertToLetter = vArr(0)
End Function

...由 brettdj in one of his precious answers 友情提供（别忘了为他点赞 ;）。

P.s。请注意，这也解释了为什么较小的数字不会引发异常：只要数字很小，您的函数就不需要在输出中附加第二个字母，因此它会保持一致。但是一旦它必须这样做，崩溃 ;)

使用上面的函数，它更安全，因为它只是从 Cells 对象中检索 Range 地址。一旦您将旧函数替换为上面的新函数，您的代码就会正常工作。

运行时错误“1004”：应用程序定义或对象定义的错误，重复使用 "range" 对象

Run-time error '1004': Application-defined or object-defined error with repeated use of "range" object

vba

runtime