文档控制编号分配VBA代码报错，请求排查修复

我有一个用来追踪已创建和待创建文档的表格。给新文档分配控制编号时，因无法清晰查看编号导致重复，因此尝试将不同类型的文档拆分，并进一步按设备类型及具体主题划分。同时，非连续编号的位置需要留空，因为控制编号需在同一设备内保持一致，仅通过设备唯一标识区分。我已在代码中定义了控制编号各部分的含义，并为每个设备/主题组合分配了对应列，但编写的VBA代码出现报错，无法排查问题。

原报错代码 #

Sub AssignValuesAndCopy()
    Dim ws As Worksheet
    Dim sourceCell As Range
    Dim firstPart As String
    Dim middlePart As String
    Dim lastPart As String
    Dim assignedValue As String
    Dim otherItem As String
    Dim targetSheet As Worksheet
    Dim targetColumn As Long
    Dim sequentialStart As Long

    ' Set the worksheet (change "Sheet2" to your actual sheet name)
    Set ws = ThisWorkbook.Sheets("Documents")

    ' Find the last used row in column B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' Loop through each row
    For i = 1 To lastRow
        Set sourceCell = ws.Cells(i, 2) ' Column B

   parts = Split(sourceCell.Value, "-")
 ' Extract the first, middle, and last parts
    firstPart = Split(sourceCell.Value, "-")(0)
        ' Extract the middle part (if it exists)
        If UBound(parts) >= 1 Then
            middlePart = parts(1)
        Else
            middlePart = "" ' Handle cases where there is no middle part
        End If
    ' Extract the last part (if it exists)
        If UBound(parts) >= 2 Then
            lastPart = parts(2)
        Else
            lastPart = "" ' Handle cases where there is no last part
        End If

    ' Assign values based on the first part
    Select Case firstPart
        Case "INS"
            assignedValue = "INS"
        Case "RTF"
            assignedValue = "RTF"
        Case "SFT"
            assignedValue = "SFT"
        Case "SPT"
            assignedValue = "SPT"
        Case "SVC"
            assignedValue = "SVC"
        Case "TNG"
            assignedValue = "TNG"
        Case "TST"
            assignedValue = "TST"
        Case "WKI"
            assignedValue = "WKI"
        
    End Select
    
    ' Assign values based on the middle part
    Select Case middlePart
        Case "T20"
            assignedValue = "1"
        Case "D20"
            assignedValue = "2"
        Case "H20"
            assignedValue = "3"
        Case "T23"
            assignedValue = "5"
        Case "D23"
            assignedValue = "6"
        Case "H23"
            assignedValue = "7"
        Case "T26"
            assignedValue = "9"
        Case "D26"
            assignedValue = "10"
        Case "H26"
            assignedValue = "11"
        Case "T28"
            assignedValue = "13"
        Case "D28"
            assignedValue = "14"
        Case "H28"
            assignedValue = "15"
        Case "T30"
            assignedValue = "17"
        Case "D30"
            assignedValue = "18"
        Case "H30"
            assignedValue = "19"
        Case "T38"
            assignedValue = "21"
        Case "D38"
            assignedValue = "22"
        Case "H38"
            assignedValue = "23"
        Case "T53"
            assignedValue = "25"
        Case "D53"
            assignedValue = "26"
        Case "H53"
            assignedValue = "27"
        Case "T56"
            assignedValue = "29"
        Case "D56"
            assignedValue = "30"
        Case "H56"
            assignedValue = "31"
        Case "T60"
            assignedValue = "33"
        Case "D60"
            assignedValue = "34"
        Case "H60"
            assignedValue = "35"
        Case "T61"
            assignedValue = "37"
        Case "D61"
            assignedValue = "38"
        Case "H61"
            assignedValue = "39"
        Case "T62"
            assignedValue = "41"
        Case "D62"
            assignedValue = "42"
        Case "H62"
            assignedValue = "43"
        Case "T65"
            assignedValue = "45"
        Case "D65"
            assignedValue = "46"
        Case "H65"
            assignedValue = "47"
        Case "T66"
            assignedValue = "49"
        Case "D66"
            assignedValue = "50"
        Case "H66"
            assignedValue = "51"
        Case "T70"
            assignedValue = "52"
        Case "D70"
            assignedValue = "53"
        Case "H70"
            assignedValue = "54"
        Case "T80"
            assignedValue = "5"
        Case "D80"
            assignedValue = "58"
        Case "H80"
            assignedValue = "59"
    End Select
  
    ' Determine the target sheet based on the first value
    Set targetSheet = ThisWorkbook.Sheets(firstPart) ' Assumes sheet names match assigned values

    ' Set the target column (e.g., column B)
    targetColumn = Val(middlePart)

    ' Copy the assigned value to the specified target sheet and column
    targetSheet.Cells(1, targetColumn).Value = assignedValue
Next i
   
    MsgBox "Values assigned and copied successfully!"
End Sub

错误排查点 #

• 未声明变量：lastRow、i、parts未声明，VBA默认变体类型易引发隐式错误。
• 变量被覆盖：两个Select Case先后给assignedValue赋值，后一次会完全覆盖前一次结果，破坏文档类型与列号的关联逻辑。
• 目标列逻辑矛盾：targetColumn = Val(middlePart)会提取middlePart中的数字（如"T20"得到20），但你定义的映射是"T20"对应列1，逻辑完全不符。
• 工作表存在性未验证：直接通过firstPart获取工作表，若对应工作表不存在会直接抛出运行时错误。
• 空单元格未处理：源单元格为空时，Split函数会报错中断程序。
• 目标行逻辑缺失：代码始终写入目标工作表第1行，未利用控制编号的lastPart实现非连续编号留空的需求。

修复后的代码 #

Option Explicit ' 强制变量声明，避免隐式错误

Sub AssignValuesAndCopy()
    Dim ws As Worksheet
    Dim sourceCell As Range
    Dim firstPart As String
    Dim middlePart As String
    Dim lastPart As String
    Dim docType As String ' 存储文档类型（INS/RTF等）
    Dim targetColNum As Long ' 存储目标列号
    Dim targetRowNum As Long ' 存储目标行号
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim parts As Variant

    ' 设置源工作表
    Set ws = ThisWorkbook.Sheets("Documents")

    ' 获取B列最后一行
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' 遍历每一行
    For i = 1 To lastRow
        Set sourceCell = ws.Cells(i, 2)
        
        ' 跳过空单元格
        If sourceCell.Value = "" Then GoTo NextRow

        ' 拆分控制编号
        parts = Split(sourceCell.Value, "-")
        
        ' 提取各部分
        firstPart = parts(0)
        middlePart = IIf(UBound(parts) >= 1, parts(1), "")
        lastPart = IIf(UBound(parts) >= 2, parts(2), "")
        
        ' 验证行号是否有效
        If Not IsNumeric(lastPart) Then
            MsgBox "第" & i & "行的编号行号部分无效: " & lastPart, vbExclamation
            GoTo NextRow
        End If
        targetRowNum = CLng(lastPart)

        ' 获取文档类型
        Select Case firstPart
            Case "INS", "RTF", "SFT", "SPT", "SVC", "TNG", "TST", "WKI"
                docType = firstPart
            Case Else
                MsgBox "第" & i & "行的文档类型无效: " & firstPart, vbExclamation
                GoTo NextRow
        End Select

        ' 获取目标列号
        Select Case middlePart
            Case "T20": targetColNum = 1
            Case "D20": targetColNum = 2
            Case "H20": targetColNum = 3
            Case "T23": targetColNum = 5
            Case "D23": targetColNum = 6
            Case "H23": targetColNum = 7
            Case "T26": targetColNum = 9
            Case "D26": targetColNum = 10
            Case "H26": targetColNum = 11
            Case "T28": targetColNum = 13
            Case "D28": targetColNum = 14
            Case "H28": targetColNum = 15
            Case "T30": targetColNum = 17
            Case "D30": targetColNum = 18
            Case "H30": targetColNum = 19
            Case "T38": targetColNum = 21
            Case "D38": targetColNum = 22
            Case "H38": targetColNum = 23
            Case "T53": targetColNum = 25
            Case "D53": targetColNum = 26
            Case "H53": targetColNum = 27
            Case "T56": targetColNum = 29
            Case "D56": targetColNum = 30
            Case "H56": targetColNum = 31
            Case "T60": targetColNum = 33
            Case "D60": targetColNum = 34
            Case "H60": targetColNum = 35
            Case "T61": targetColNum = 37
            Case "D61": targetColNum = 38
            Case "H61": targetColNum = 39
            Case "T62": targetColNum = 41
            Case "D62": targetColNum = 42
            Case "H62": targetColNum = 43
            Case "T65": targetColNum = 45
            Case "D65": targetColNum = 46
            Case "H65": targetColNum = 47
            Case "T66": targetColNum = 49
            Case "D66": targetColNum = 50
            Case "H66": targetColNum = 51
            Case "T70": targetColNum = 52
            Case "D70": targetColNum = 53
            Case "H70": targetColNum = 54
            Case "T80": targetColNum = 5 ' 注意：此处与T23列号重复，需确认是否为笔误
            Case "D80": targetColNum = 58
            Case "H80": targetColNum = 59
            Case Else
                MsgBox "第" & i & "行的设备类型无效: " & middlePart, vbExclamation
                GoTo NextRow
        End Select

        ' 检查目标工作表是否存在
        On Error Resume Next
        Set targetSheet = ThisWorkbook.Sheets(docType)
        On Error GoTo 0
        If targetSheet Is Nothing Then
            MsgBox "未找到工作表: " & docType, vbCritical
            GoTo NextRow
        End If

        ' 写入控制编号到目标单元格
        targetSheet.Cells(targetRowNum, targetColNum).Value = sourceCell.Value

NextRow:
        ' 重置变量，避免循环污染
        Set targetSheet = Nothing
        docType = ""
        targetColNum = 0
        targetRowNum = 0
    Next i
   
    MsgBox "控制编号分配完成!", vbInformation
End Sub

内容的提问来源于stack exchange，提问作者jazzcelt85