6

全部，

我在 Excel 宏中遇到了一些 VBA 代码错误。这是我正在尝试的工作流程：

  • 我有一个模块运行代码来创建一个新的工作表，格式化它并添加一堆值
  • 在同一个模块中，我根据填充的最后一行确定一系列单元格（根据前面的步骤，这总是不同的）

  • 一旦我知道这个范围，我使用下面的代码写入新创建的工作表代码模块，这样我就可以设置一个“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

该代码有效，并将以下内容写入指定工作表的代码模块：

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`

此代码也有效，并且当区域中的单元格发生更改时会出现消息框。但是，随着 VBE关闭，它会产生错误：

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

点击调试将我带到了这条线：

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

但它实际上在以下行引发了错误：

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

1 回答 1

3

我不确定您为什么会收到该错误，但这是另一种可以避免它的方法

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
于 2011-05-27T18:11:14.060 回答