Excel VBA路径追踪代码开发需求：按规则生成转运路径

功能需求 #

• 从指定FROM列出发，匹配对应TO列节点，循环追踪路径，直至路径终点或累计达到3个Tran stops（位于指定列）
• 若起点为Tran stops，计数从1开始；否则从0开始
• 仅记录长度大于1的唯一路径，已加入路径的节点不再重复处理
• 支持处理乱序数据，例如：

  苹果→香蕉
  葡萄→猕猴桃
  香蕉→葡萄
  需识别出正确路径：苹果→香蕉→葡萄→猕猴桃

• 将最终路径输出至工作表中

修正后VBA代码 #

Sub TrackPaths()
    Dim ws As Worksheet
    Dim fromRng As Range, toRng As Range, tranStopsRng As Range
    Dim nodeMap As Object ' 存储FROM到TO的映射，处理乱序数据
    Dim pathNodes As Collection ' 单条路径的已访问节点
    Dim currentNode As String, nextNode As String
    Dim tranCount As Integer
    Dim outputRow As Integer
    Dim i As Long
    Dim isTranStop As Boolean
    
    ' 初始化工作表和区域，根据实际情况修改
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set fromRng = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    Set toRng = ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
    Set tranStopsRng = ws.Range("D2:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row)
    
    ' 创建节点映射字典，快速查找下一个节点
    Set nodeMap = CreateObject("Scripting.Dictionary")
    For i = 1 To fromRng.Rows.Count
        If Not nodeMap.Exists(fromRng.Cells(i, 1).Value) Then
            nodeMap(fromRng.Cells(i, 1).Value) = toRng.Cells(i, 1).Value
        End If
    Next i
    
    ' 初始化输出行，输出到F列（可修改）
    outputRow = 2
    ws.Range("F2:F" & ws.Rows.Count).ClearContents ' 清空之前的输出
    
    ' 遍历所有起点
    For i = 1 To fromRng.Rows.Count
        currentNode = fromRng.Cells(i, 1).Value
        ' 跳过已作为路径中间节点处理过的起点
        If Not IsNodeInAnyPath(currentNode, ws, outputRow) Then
            Set pathNodes = New Collection
            tranCount = 0
            
            ' 检查起点是否为Tran Stop
            isTranStop = Not IsError(Application.Match(currentNode, tranStopsRng, 0))
            If isTranStop Then tranCount = 1
            
            ' 添加起点到当前路径
            pathNodes.Add currentNode
            
            ' 追踪路径
            Do While tranCount < 3
                ' 查找下一个节点
                If nodeMap.Exists(currentNode) Then
                    nextNode = nodeMap(currentNode)
                Else
                    nextNode = ""
                End If
                
                ' 下一个节点为空，或已在当前路径中，终止追踪
                If nextNode = "" Or IsInCollection(pathNodes, nextNode) Then
                    Exit Do
                End If
                
                ' 添加下一个节点到路径
                pathNodes.Add nextNode
                
                ' 检查是否为Tran Stop，更新计数
                isTranStop = Not IsError(Application.Match(nextNode, tranStopsRng, 0))
                If isTranStop Then
                    tranCount = tranCount + 1
                End If
                
                currentNode = nextNode
            Loop
            
            ' 输出长度大于1的路径
            If pathNodes.Count > 1 Then
                ws.Cells(outputRow, "F").Value = Join(CollectionToArray(pathNodes), " → ")
                outputRow = outputRow + 1
            End If
        End If
    Next i
    
    MsgBox "路径追踪完成，结果已输出到F列", vbInformation
End Sub

' 辅助函数：检查元素是否在集合中
Function IsInCollection(col As Collection, item As Variant) As Boolean
    Dim var As Variant
    IsInCollection = False
    For Each var In col
        If var = item Then
            IsInCollection = True
            Exit Function
        End If
    Next var
End Function

' 辅助函数：将集合转为数组，用于Join拼接路径
Function CollectionToArray(col As Collection) As Variant
    Dim arr() As String
    ReDim arr(1 To col.Count)
    Dim i As Integer
    For i = 1 To col.Count
        arr(i) = col(i)
    Next i
    CollectionToArray = arr
End Function

' 辅助函数：检查节点是否已作为路径的一部分输出过，避免重复处理
Function IsNodeInAnyPath(node As String, ws As Worksheet, outputRow As Integer) As Boolean
    Dim cell As Range
    IsNodeInAnyPath = False
    For Each cell In ws.Range("F2:F" & outputRow - 1)
        If InStr(cell.Value, node) > 0 Then
            IsNodeInAnyPath = True
            Exit Function
        End If
    Next cell
End Function

代码关键说明 #

• 节点映射字典：提前存储FROM与TO列的对应关系，解决乱序数据的快速匹配问题，比循环遍历效率更高
• 单路径已访问集合：每条路径单独维护已访问节点，避免全局集合导致后续起点无法复用已被其他路径使用的节点
• Tran Stop计数逻辑：严格遵循需求，起点为Tran Stop时计数从1开始，每次遇到Tran Stop累加计数，达到3个时终止追踪
• 重复路径过滤：通过辅助函数跳过已作为路径中间节点的起点，确保输出路径唯一
• 输出格式化：将集合转为数组后用Join拼接成标准路径格式，仅输出长度大于1的有效路径

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