Excel VBA - For/While 循环节点路径问题
Excel VBA - For/While Loop in a Node-Path Problem
所以，
我有一组字符串 (Connector_String)，其中包含显示所有可能连接的字符串（代表类似网络的节点连接）。 Connector_String 具有以下格式（我认为这对我有帮助，但如果需要我可以更改它）：
- 以
"-" 开始和结束
- 连接的节点（始终为 2）表示为
String1*String2
"*"前的节点表示方向。因此，对于上述内容，方向是 String1 --> String2- 由
"-" 分隔的连接节点
例如，
-RANDIAC*RANDACBD-RANDV*RANDIF-...-RANDA*RANDACAC-
这意味着 RANDIAC 与 RANDACBD 等连接。还要注意 RANDIAC 可以与另一个节点连接。
我正在尝试列出给定起点和终点的节点之间的所有可能路径。为此，我有两个字符串，其中包括所有起始节点 (Start_String) 和结束节点 (End_String)。格式如下：
-RAND26RD-RAND06RD-...-RAND12RD-
我开始编写一个 for 循环代码来遍历 Connector_String 但我很快意识到我必须多次编写相同的循环（我不知道如何定义多少次).然后我写了一个 Do While 循环代码（我第一次使用它），结果根本没有 运行ning（我不明白为什么）。然后，我尝试用我在 Sub 上使用的相同 for 循环编写一个 Function，然后 运行 在 Sub 中使用 Function并在 'Function' 中（希望它能完成与 Do While 循环相同的工作）。
None 我的代码有效，但我添加了我的最后一次尝试，因为建议将它放在问题上（尽管我怀疑有经验的人是否会阅读它，因为它不太好书面 - 加上不起作用）。
Public Function Str_Search(a As String) As String
Dim i As Long
Debug.Print "Func " & a
If InStr(End_Str, Split(a, "-")(UBound(Split(a, "-")))) > 0 Then
Str_Search = a
Exit Function
End If
For i = 1 To UBound(Split(Connector_String, "-")) - 1
If Split(a, "-")(UBound(Split(a, "-"))) = Split(Split(Connector_String, "-")(i), "*")(0) Then
a = a & "-" & Split(Split(Connector_String, "-")(i), "*")(1)
Str_Search (a)
End If
Next i
End Function
Sub test_V4()
Dim a As String
Dim i As Long
a = ""
For i = 1 To UBound(Split(Connector_String, "-")) - 1
If InStr(Start_String, Split(Split(Connector_String, "-")(i), "*")(0)) > 0 Then
a = Replace(Split(Connector_String, "-")(i), "*", "-")
ElseIf a <> "" Then
Str_Search (a)
ElseIf InStr(End_String, Split(a, "-")(UBound(Split(a, "-")))) > 0 Then
Exit Sub
End If
Next
End Sub
最后，我的节点的另一个棘手问题是有些节点是双向的（因此，我可能有 String1*String2 和 String2*String1），这会造成创建无限循环的问题（我没有不要尝试在我的代码中解决这个问题，因为我什至无法获得一些路径）。
见下面的字符串：
Start_String
-RAND_VW_E-RAND_VG_E-RAND_VG_F-RAND_M_2C-RAND_M_3A-RAND_VW_D-RAND_VW_V-RAND_M_1E-RAND_M_4E-RAND_VG_V-RAND_M_2D-RAND_M_3B-RAND_VW_C-RAND_VG_D-RAND_M_1F-RAND_M_4F-RAND_I_LINE-RAND_M_1E & RAND_M_4E-RAND_M_1F & RAND_M_4F
End_String
-RAND26RD-RAND06RD-RAND08RD-RAND12RD-RAND06RD-RAND02RD-RAND07RD-RAND01RD-RAND05RD-RAND03RD-RAND09RD-RAND04RD-RAND10RD-RAND20RD-RAND21RD-RAND22RD-RAND23RD-
Connector_String
-RANDIAC*RANDACBD-RANDV*RANDIF-RANDV*RANDIBD-RANDBD*RAND26RD-RANDACBD*RANDBD-RAND67F*RAND06RD-RAND89AC*RAND08RD-RANDACAC*RAND89AC-RANDA*RANDACAC-RAND_VW_E*RANDE-RAND_VG_E*RANDE-RAND_VG_F*RANDF-RAND_M_2C*RANDC-RAND_M_3A*RANDA-RANDEBD*RANDBD-RANDE*RANDEBD-RANDI*RANDIBD-RANDIBD*RANDBD-RANDF*RANDFNTH-RANDACAC*RANDACBD-RAND_VW_D*RANDD-RANDFSTH*RAND12F-RAND12F*RAND12RD-RANDIAC*RAND67AC-RAND67AC*RAND06RD-RANDFSTH*RAND02F-RAND02F*RAND02RD-RAND_VW_V*RANDV-RANDE*RANDEF-RAND_M_1E*RANDE-RAND_M_4E*RANDE-RANDEF*RANDFSTH-RAND_VG_V*RANDV-RANDV*RANDIAC-RANDFSTH*RAND67F-RAND67F*RAND07RD-RANDFNTH*RAND01RD-RANDIF*RANDFSTH-RANDB*RANDBD-RAND_M_2D*RANDD-RAND_M_3B*RANDB-RANDI*RANDIF-RANDIF*RANDFNTH-RANDFNTH*RAND05RD-RANDC*RANDACAC-RAND_VW_C*RANDC-RANDACAC*RAND67AC-RAND67AC*RAND07RD-RAND_VG_D*RANDD-RANDD*RANDBD-RAND_M_1F*RANDF-RAND_M_4F*RANDF-RANDFSTH*RAND03F-RAND03F*RAND03RD-RANDI*RANDIAC-RAND_I_LINE*RANDI-RANDIAC*RAND89AC-RAND89AC*RAND09RD-RANDF*RANDFSTH-RANDFSTH*RAND0410-RAND0410*RAND04RD-RAND0410*RAND10RD-RANDBD*RAND26BD-RANDFSTH*RANDFWST-RANDFWST*RANDFX-RAND20X*RAND20RD-RAND21X*RAND21RD-RANDFX*RAND21X-RANDFX*RAND20X-RANDEF*RANDFNTH-RANDACAC*RANDJET-RAND22Y*RAND22RD-RAND23Y*RAND23RD-RANDACY*RAND23Y-RANDJET*RANDACY-RANDACY*RAND22Y-RAND23Y*RAND23BD-RAND22Y*RAND22BD-RAND22Y*RAND23BD-RAND26BD*RAND22BD-RAND26BD*RAND23BD-RAND23BD*RAND26BD-RAND22BD*RAND26BD-RAND23BD*RAND23RD-RAND22BD*RAND22RD-RAND26BD*RAND26RD-RANDJET*RANDACX-RANDACX*RAND20X-RANDACX*RAND21X-RANDACX*RANDFX-RANDFX*RANDFWST-RANDFWST*RANDFSTH-RANDFSTH*RANDFNTH-
希望有人能帮助我。
将连接复制到名为 Connector.txt 的文本文件，并保存在与工作簿相同的文件夹中。连接写入 Sheet1，路由写入 Sheet2。使用从连接器文件构建的字典 dict 跟踪路由。 route 数组存储沿路径递归的节点。端点以黄色突出显示。
Option Explicit
Dim dictEnd As Object
Dim dict As Object
Sub Str_Search()
Const CONFILE = "Connector.txt"
' dictionaries
Set dictEnd = CreateObject("Scripting.Dictionary")
Call EndNodes(dictEnd)
'MsgBox Join(dictEnd.keys, vbLf)
Set dict = CreateObject("Scripting.Dictionary")
Call ConnectedNodes(dict, ThisWorkbook.Path & "\" & CONFILE)
' dump source to check
Call DumpConnected(Sheet1, dict)
' trace routes to sheet2
Const STEPS = 20
Dim route(1 To STEPS) As String, arStart, k
Dim n As Long, r As Long
r = 2
arStart = StartNodes()
With Sheet2
.Cells.Clear
.Cells(1, 1) = "Start Node"
For n = 0 To UBound(arStart)
k = arStart(n)
If dict.exists(k) Then
route(1) = k
Call TraceRoute(route, 1, r, Sheet2)
r = r + 1
ElseIf Len(k) > 0 Then
MsgBox k & " not found", vbCritical
End If
Next
.Columns.AutoFit
End With
MsgBox "Done", vbInformation
End Sub
Sub TraceRoute(ByRef route, ByRef i As Long, ByRef r As Long, ws As Worksheet)
'Debug.Print r, i, route(i)
Dim node As String, dest As String
Dim n As Long, j As Long, msg As String
' current node
node = route(i)
ws.Cells(r, i) = node
' is end node
If dictEnd.exists(node) Then
ws.Cells(r, i).Interior.Color = RGB(255, 255, 0)
End If
' check not infinite loop
For j = 1 To i - 1
If route(j) = node Then
msg = "Inf Loop "
ws.Cells(r, i + 1) = msg
r = r + 1
Exit Sub
End If
Next
' end of route ?
If Not dict.exists(node) Then
r = r + 1
Exit Sub
End If
msg = ""
For n = 1 To dict(node).Count
dest = dict(node).Item(n)
' recurse
If dict.exists(dest) Then
i = i + 1
route(i) = dest
Call TraceRoute(route, i, r, ws)
i = i - 1
Else
ws.Cells(r, i + 1) = dest
If dictEnd.exists(dest) Then
ws.Cells(r, i + 1).Interior.Color = RGB(255, 255, 0)
End If
r = r + 1
End If
Next
End Sub
Function StartNodes() As Variant
StartNodes = Split("-RAND_VW_E-RAND_VG_E-RAND_VG_F-RAND_M_2C-RAND_M_3A-RAND_VW_D-RAND_VW_V" & _
"-RAND_M_1E-RAND_M_4E-RAND_VG_V-RAND_M_2D-RAND_M_3B-RAND_VW_C-RAND_VG_D" & _
"-RAND_M_1F-RAND_M_4F-RAND_I_LINE-RAND_M_1E-RAND_M_4E-RAND_M_1F-RAND_M_4F", "-")
End Function
Sub EndNodes(ByRef d)
Dim k
For Each k In Split("-RAND26RD-RAND06RD-RAND08RD-RAND12RD-RAND06RD-RAND02RD-RAND07RD-RAND01RD" & _
"-RAND05RD-RAND03RD-RAND09RD-RAND04RD-RAND10RD-RAND20RD-RAND21RD-RAND22RD-RAND23RD-", "-")
If Len(Trim(k)) > 0 Then d(Trim(k)) = 1
Next
MsgBox d.Count & " End Nodes"
End Sub
Sub ConnectedNodes(ByRef d, filename As String)
' read connection file
Dim FSO As Object, ts As Object, sTxt As String
Set FSO = CreateObject("Scripting.FilesystemObject")
Set ts = FSO.OpenTextFile(filename)
sTxt = ts.readAll
ts.Close
' regular expression
Dim regex As Object, m As Object, node As Object
Dim n As Long, k
Set regex = CreateObject("vbscript.regexp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "(?:-([^*]+)\*([^-]+))"
End With
' parse file
If regex.test(sTxt) Then
Set m = regex.Execute(sTxt) '
For n = 1 To m.Count
Set node = m.Item(n - 1).submatches
k = Trim(node(0))
If Not dict.exists(k) And Len(k) > 0 Then
dict.Add k, New Collection
End If
dict(k).Add Trim(node(1))
Next
End If
MsgBox d.Count & " Connectd Nodes"
End Sub
Sub DumpConnected(ws As Worksheet, dict)
Dim k, r As Long, n As Long
r = 1
With ws
.Cells.Clear
.Cells(r, 1) = "Start Node"
For Each k In dict
r = r + 1
.Cells(r, 1) = k
For n = 1 To dict(k).Count
.Cells(r, n + 1) = dict(k).Item(n)
Next
Next
.Columns.AutoFit
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("A1"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange ws.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
所以，
我有一组字符串 (Connector_String)，其中包含显示所有可能连接的字符串（代表类似网络的节点连接）。 Connector_String 具有以下格式（我认为这对我有帮助，但如果需要我可以更改它）：
- 以
"-" 开始和结束
- 连接的节点（始终为 2）表示为
String1*String2 "*"前的节点表示方向。因此，对于上述内容，方向是String1-->String2- 由
"-" 分隔的连接节点
例如，
-RANDIAC*RANDACBD-RANDV*RANDIF-...-RANDA*RANDACAC-
这意味着 RANDIAC 与 RANDACBD 等连接。还要注意 RANDIAC 可以与另一个节点连接。
我正在尝试列出给定起点和终点的节点之间的所有可能路径。为此，我有两个字符串，其中包括所有起始节点 (Start_String) 和结束节点 (End_String)。格式如下：
-RAND26RD-RAND06RD-...-RAND12RD-
我开始编写一个 for 循环代码来遍历 Connector_String 但我很快意识到我必须多次编写相同的循环（我不知道如何定义多少次).然后我写了一个 Do While 循环代码（我第一次使用它），结果根本没有 运行ning（我不明白为什么）。然后，我尝试用我在 Sub 上使用的相同 for 循环编写一个 Function，然后 运行 在 Sub 中使用 Function并在 'Function' 中（希望它能完成与 Do While 循环相同的工作）。
None 我的代码有效，但我添加了我的最后一次尝试，因为建议将它放在问题上（尽管我怀疑有经验的人是否会阅读它，因为它不太好书面 - 加上不起作用）。
Public Function Str_Search(a As String) As String
Dim i As Long
Debug.Print "Func " & a
If InStr(End_Str, Split(a, "-")(UBound(Split(a, "-")))) > 0 Then
Str_Search = a
Exit Function
End If
For i = 1 To UBound(Split(Connector_String, "-")) - 1
If Split(a, "-")(UBound(Split(a, "-"))) = Split(Split(Connector_String, "-")(i), "*")(0) Then
a = a & "-" & Split(Split(Connector_String, "-")(i), "*")(1)
Str_Search (a)
End If
Next i
End Function
Sub test_V4()
Dim a As String
Dim i As Long
a = ""
For i = 1 To UBound(Split(Connector_String, "-")) - 1
If InStr(Start_String, Split(Split(Connector_String, "-")(i), "*")(0)) > 0 Then
a = Replace(Split(Connector_String, "-")(i), "*", "-")
ElseIf a <> "" Then
Str_Search (a)
ElseIf InStr(End_String, Split(a, "-")(UBound(Split(a, "-")))) > 0 Then
Exit Sub
End If
Next
End Sub
最后，我的节点的另一个棘手问题是有些节点是双向的（因此，我可能有 String1*String2 和 String2*String1），这会造成创建无限循环的问题（我没有不要尝试在我的代码中解决这个问题，因为我什至无法获得一些路径）。
见下面的字符串：
Start_String
-RAND_VW_E-RAND_VG_E-RAND_VG_F-RAND_M_2C-RAND_M_3A-RAND_VW_D-RAND_VW_V-RAND_M_1E-RAND_M_4E-RAND_VG_V-RAND_M_2D-RAND_M_3B-RAND_VW_C-RAND_VG_D-RAND_M_1F-RAND_M_4F-RAND_I_LINE-RAND_M_1E & RAND_M_4E-RAND_M_1F & RAND_M_4F
End_String
-RAND26RD-RAND06RD-RAND08RD-RAND12RD-RAND06RD-RAND02RD-RAND07RD-RAND01RD-RAND05RD-RAND03RD-RAND09RD-RAND04RD-RAND10RD-RAND20RD-RAND21RD-RAND22RD-RAND23RD-
Connector_String
-RANDIAC*RANDACBD-RANDV*RANDIF-RANDV*RANDIBD-RANDBD*RAND26RD-RANDACBD*RANDBD-RAND67F*RAND06RD-RAND89AC*RAND08RD-RANDACAC*RAND89AC-RANDA*RANDACAC-RAND_VW_E*RANDE-RAND_VG_E*RANDE-RAND_VG_F*RANDF-RAND_M_2C*RANDC-RAND_M_3A*RANDA-RANDEBD*RANDBD-RANDE*RANDEBD-RANDI*RANDIBD-RANDIBD*RANDBD-RANDF*RANDFNTH-RANDACAC*RANDACBD-RAND_VW_D*RANDD-RANDFSTH*RAND12F-RAND12F*RAND12RD-RANDIAC*RAND67AC-RAND67AC*RAND06RD-RANDFSTH*RAND02F-RAND02F*RAND02RD-RAND_VW_V*RANDV-RANDE*RANDEF-RAND_M_1E*RANDE-RAND_M_4E*RANDE-RANDEF*RANDFSTH-RAND_VG_V*RANDV-RANDV*RANDIAC-RANDFSTH*RAND67F-RAND67F*RAND07RD-RANDFNTH*RAND01RD-RANDIF*RANDFSTH-RANDB*RANDBD-RAND_M_2D*RANDD-RAND_M_3B*RANDB-RANDI*RANDIF-RANDIF*RANDFNTH-RANDFNTH*RAND05RD-RANDC*RANDACAC-RAND_VW_C*RANDC-RANDACAC*RAND67AC-RAND67AC*RAND07RD-RAND_VG_D*RANDD-RANDD*RANDBD-RAND_M_1F*RANDF-RAND_M_4F*RANDF-RANDFSTH*RAND03F-RAND03F*RAND03RD-RANDI*RANDIAC-RAND_I_LINE*RANDI-RANDIAC*RAND89AC-RAND89AC*RAND09RD-RANDF*RANDFSTH-RANDFSTH*RAND0410-RAND0410*RAND04RD-RAND0410*RAND10RD-RANDBD*RAND26BD-RANDFSTH*RANDFWST-RANDFWST*RANDFX-RAND20X*RAND20RD-RAND21X*RAND21RD-RANDFX*RAND21X-RANDFX*RAND20X-RANDEF*RANDFNTH-RANDACAC*RANDJET-RAND22Y*RAND22RD-RAND23Y*RAND23RD-RANDACY*RAND23Y-RANDJET*RANDACY-RANDACY*RAND22Y-RAND23Y*RAND23BD-RAND22Y*RAND22BD-RAND22Y*RAND23BD-RAND26BD*RAND22BD-RAND26BD*RAND23BD-RAND23BD*RAND26BD-RAND22BD*RAND26BD-RAND23BD*RAND23RD-RAND22BD*RAND22RD-RAND26BD*RAND26RD-RANDJET*RANDACX-RANDACX*RAND20X-RANDACX*RAND21X-RANDACX*RANDFX-RANDFX*RANDFWST-RANDFWST*RANDFSTH-RANDFSTH*RANDFNTH-
希望有人能帮助我。
将连接复制到名为 Connector.txt 的文本文件，并保存在与工作簿相同的文件夹中。连接写入 Sheet1，路由写入 Sheet2。使用从连接器文件构建的字典 dict 跟踪路由。 route 数组存储沿路径递归的节点。端点以黄色突出显示。
Option Explicit
Dim dictEnd As Object
Dim dict As Object
Sub Str_Search()
Const CONFILE = "Connector.txt"
' dictionaries
Set dictEnd = CreateObject("Scripting.Dictionary")
Call EndNodes(dictEnd)
'MsgBox Join(dictEnd.keys, vbLf)
Set dict = CreateObject("Scripting.Dictionary")
Call ConnectedNodes(dict, ThisWorkbook.Path & "\" & CONFILE)
' dump source to check
Call DumpConnected(Sheet1, dict)
' trace routes to sheet2
Const STEPS = 20
Dim route(1 To STEPS) As String, arStart, k
Dim n As Long, r As Long
r = 2
arStart = StartNodes()
With Sheet2
.Cells.Clear
.Cells(1, 1) = "Start Node"
For n = 0 To UBound(arStart)
k = arStart(n)
If dict.exists(k) Then
route(1) = k
Call TraceRoute(route, 1, r, Sheet2)
r = r + 1
ElseIf Len(k) > 0 Then
MsgBox k & " not found", vbCritical
End If
Next
.Columns.AutoFit
End With
MsgBox "Done", vbInformation
End Sub
Sub TraceRoute(ByRef route, ByRef i As Long, ByRef r As Long, ws As Worksheet)
'Debug.Print r, i, route(i)
Dim node As String, dest As String
Dim n As Long, j As Long, msg As String
' current node
node = route(i)
ws.Cells(r, i) = node
' is end node
If dictEnd.exists(node) Then
ws.Cells(r, i).Interior.Color = RGB(255, 255, 0)
End If
' check not infinite loop
For j = 1 To i - 1
If route(j) = node Then
msg = "Inf Loop "
ws.Cells(r, i + 1) = msg
r = r + 1
Exit Sub
End If
Next
' end of route ?
If Not dict.exists(node) Then
r = r + 1
Exit Sub
End If
msg = ""
For n = 1 To dict(node).Count
dest = dict(node).Item(n)
' recurse
If dict.exists(dest) Then
i = i + 1
route(i) = dest
Call TraceRoute(route, i, r, ws)
i = i - 1
Else
ws.Cells(r, i + 1) = dest
If dictEnd.exists(dest) Then
ws.Cells(r, i + 1).Interior.Color = RGB(255, 255, 0)
End If
r = r + 1
End If
Next
End Sub
Function StartNodes() As Variant
StartNodes = Split("-RAND_VW_E-RAND_VG_E-RAND_VG_F-RAND_M_2C-RAND_M_3A-RAND_VW_D-RAND_VW_V" & _
"-RAND_M_1E-RAND_M_4E-RAND_VG_V-RAND_M_2D-RAND_M_3B-RAND_VW_C-RAND_VG_D" & _
"-RAND_M_1F-RAND_M_4F-RAND_I_LINE-RAND_M_1E-RAND_M_4E-RAND_M_1F-RAND_M_4F", "-")
End Function
Sub EndNodes(ByRef d)
Dim k
For Each k In Split("-RAND26RD-RAND06RD-RAND08RD-RAND12RD-RAND06RD-RAND02RD-RAND07RD-RAND01RD" & _
"-RAND05RD-RAND03RD-RAND09RD-RAND04RD-RAND10RD-RAND20RD-RAND21RD-RAND22RD-RAND23RD-", "-")
If Len(Trim(k)) > 0 Then d(Trim(k)) = 1
Next
MsgBox d.Count & " End Nodes"
End Sub
Sub ConnectedNodes(ByRef d, filename As String)
' read connection file
Dim FSO As Object, ts As Object, sTxt As String
Set FSO = CreateObject("Scripting.FilesystemObject")
Set ts = FSO.OpenTextFile(filename)
sTxt = ts.readAll
ts.Close
' regular expression
Dim regex As Object, m As Object, node As Object
Dim n As Long, k
Set regex = CreateObject("vbscript.regexp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "(?:-([^*]+)\*([^-]+))"
End With
' parse file
If regex.test(sTxt) Then
Set m = regex.Execute(sTxt) '
For n = 1 To m.Count
Set node = m.Item(n - 1).submatches
k = Trim(node(0))
If Not dict.exists(k) And Len(k) > 0 Then
dict.Add k, New Collection
End If
dict(k).Add Trim(node(1))
Next
End If
MsgBox d.Count & " Connectd Nodes"
End Sub
Sub DumpConnected(ws As Worksheet, dict)
Dim k, r As Long, n As Long
r = 1
With ws
.Cells.Clear
.Cells(r, 1) = "Start Node"
For Each k In dict
r = r + 1
.Cells(r, 1) = k
For n = 1 To dict(k).Count
.Cells(r, n + 1) = dict(k).Item(n)
Next
Next
.Columns.AutoFit
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("A1"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange ws.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub