查找下一未使用刀具编号：VBA代码仅识别首行问题求助

原代码的核心问题是找到第一个匹配项后直接执行Exit Sub终止程序，导致仅能检查首行内容，无法完成全部编号的排查。此外代码逻辑存在冗余（同时用For Each cell和Row变量遍历），且未实现按刀具类型生成下一可用编号的功能。

原代码问题点 #

• 匹配到编号后立即Exit Sub，程序直接终止，后续行完全不处理
• 遍历Sheets("Alle").Range("A2:A1600")的同时，手动维护Row变量，逻辑重复易出错
• 未区分刀具类型，无法针对不同起始编号生成下一可用编号

修复后的完整代码 #

Sub FindNextAvailableToolNumber()
    Dim usedNumbers As Object
    Dim toolTypeDict As Object
    Dim ws As Worksheet
    Dim cell As Range
    Dim lastRow As Long
    Dim toolType As String
    Dim currentNum As Long
    Dim startNum As Long
    
    ' 初始化字典：存储已使用的编号，按刀具类型分类
    Set usedNumbers = CreateObject("Scripting.Dictionary")
    Set toolTypeDict = CreateObject("Scripting.Dictionary")
    
    ' 假设刀具类型在B列，起始编号在C列（根据实际情况调整）
    ' 先读取刀具类型对应的起始编号
    With Sheets("Alle")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each cell In .Range("B2:C" & lastRow)
            If cell.Column = 2 Then ' B列是刀具类型
                toolType = cell.Value
            Else ' C列是起始编号
                If Not toolTypeDict.Exists(toolType) Then
                    toolTypeDict(toolType) = cell.Value
                End If
            End If
        Next cell
    End With
    
    ' 遍历所有工作表，收集已使用的编号
    For Each ws In ActiveWorkbook.Worksheets
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For Each cell In ws.Range("A2:A" & lastRow)
            toolType = Left(cell.Value, 2) ' 假设编号前两位是刀具类型标识，根据实际调整
            currentNum = CLng(Mid(cell.Value, 3)) ' 提取编号数字部分
            If Not usedNumbers.Exists(toolType) Then
                Set usedNumbers(toolType) = CreateObject("Scripting.Dictionary")
            End If
            usedNumbers(toolType)(currentNum) = True
        Next cell
    Next ws
    
    ' 为每种刀具类型查找下一可用编号
    With Sheets("Alle")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each cell In .Range("A2:A" & lastRow)
            toolType = Left(cell.Value, 2) ' 匹配刀具类型
            startNum = toolTypeDict(toolType)
            currentNum = startNum
            
            ' 查找第一个未使用的编号
            Do While usedNumbers(toolType).Exists(currentNum)
                currentNum = currentNum + 1
            Loop
            
            ' 将结果写入D列（可根据需求调整列）
            cell.Offset(0, 3).Value = toolType & Format(currentNum, "0000") ' 格式化编号，如"DR0001"
        Next cell
    End With
    
    MsgBox "下一可用编号已生成完成！"
End Sub

代码说明 #

1. 字典存储：用两个字典分别存储刀具类型的起始编号，以及各类型下已使用的数字编号，实现高效查找
2. 遍历优化：仅遍历每个工作表的实际数据行（用lastRow获取最后一行），避免空行无效遍历
3. 终止逻辑修正：移除原代码的Exit Sub，改为完整遍历所有行和工作表
4. 类型区分：通过编号前缀或单独列识别刀具类型，按对应起始编号查找下一可用编号

注意事项 #

• 需根据实际的刀具编号规则调整类型提取逻辑（如Left(cell.Value, 2)）
• 若刀具类型和起始编号存储位置不同，需修改对应列的引用
• 确保启用Scripting.Dictionary（一般默认支持，若报错需添加引用：工具→引用→勾选Microsoft Scripting Runtime）

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