Question

我尝试使用VBA进行自动模板设计，当我输入少量的＆＃34;页面时，这段代码似乎运行良好，但是当我输入以下内容时在提示中它给我一个运行时错误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功能。实际上，在某些时候发生错误是因为函数返回了无效的范围字母：

input: iCol = 53
return: "A["

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

您的函数中的代码不是实体，因为将数字转换为带有以下内容的字母：

ConvertToLetter = Chr(iAlpha + 64)

Chr()函数返回与字符集合中的索引关联的值，这是一个唯一的字符列表，在您尝试执行此操作时无法使用。我只想用更实用的函数替换你的ConvertToLetter函数，例如：

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

...... brettdj在他的一个宝贵的answers中提供了善意的帮助（不要忘记为他提供这块金币;）。

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

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

运行时错误＆＃39; 1004＆＃39;：应用程序定义或对象定义的错误，重复使用＆＃34;范围＆＃34;宾语

1 个答案: