运行时错误“9”:下标超出范围 – 仅当Excel VBEclosures时

所有,

我在Excelmacros中遇到了一些VBA代码的错误。 这是我正在尝试的工作stream程:

  • 我有一个运行代码的模块来创build一个新的工作表,格式化并添加一堆值
  • 在这个相同的模块中,我根据最后一行填充来确定一个单元格的范围(根据之前的步骤,这个单元格总是不同的)
  • 一旦我知道这个范围,我使用下面的代码写入新创build的工作表codemodule,所以我可以设置一个'change_event'。 我只想在刚刚确定的范围内的值发生变化时触发change_event:`

    Dim Startline As Long Startline = 1 Dim x As Integer x = Errors.Count - 1 Dim rng As Range Set rng = Range("D" & LastRow - x & ":" & "D" & LastRow) With ThisWorkbook.VBProject.VBComponents(VRS.CodeName).CodeModule Startline = .CreateEventProc("Change", "Worksheet") + 1 .InsertLines Startline, "Dim rng As Range " Startline = Startline + 1 .InsertLines Startline, "Set rng = Range(" & """" & CStr(rng.Address) & """" & ")" Startline = Startline + 1 .InsertLines Startline, "If Target.Count > 1 Then Exit Sub" Startline = Startline + 1 .InsertLines Startline, "If Intersect(Target, rng) Is Nothing Then Exit Sub" Startline = Startline + 1 .InsertLines Startline, "MsgBox (""Value Changed!..."") " End With 

该代码工作,并将以下内容写入指定工作表的codemodule中:

 Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Set rng = Range("D58:D62") If Target.Count > 1 Then Exit Sub If Intersect(Target, rng) Is Nothing Then Exit Sub MsgBox ("Value Changed!...") End Sub` 

此代码也可以工作,当范围中的单元格更改时,将显示消息框。 但是, closures VBE会产生错误:

 Run-time error '9': Subscript out of range 

打到debugging把我带到了这一行:

 With ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule 

但它实际上在下面一行中引发错误:

 Startline = .CreateEventProc("Change", "Worksheet") + 1 

我不知道为什么你会得到这个错误,但这是另一种避免这种错误的方法

 Sub Main() Dim ws As Worksheet Dim rng As Range Dim sCode As String Set ws = ThisWorkbook.Worksheets.Add Set rng = ws.Range("D1:D10") sCode = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbNewLine & vbNewLine sCode = sCode & vbTab & "Dim rng As Range" & vbNewLine & vbNewLine sCode = sCode & vbTab & "Set rng = Me.Range(" & """" & rng.Address & """" & ")" & vbNewLine & vbNewLine sCode = sCode & vbTab & "If Target.Count > 1 Then Exit Sub" & vbNewLine sCode = sCode & vbTab & "If Intersect(Target, rng) Is Nothing Then Exit Sub" & vbNewLine & vbNewLine sCode = sCode & vbTab & "MsgBox (""Value Changed!..."") " & vbNewLine sCode = sCode & "End Sub" ThisWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule.AddFromString sCode End Sub