所以，
我有一組字串 ( 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回圈代碼（我第一次使用它）最終根本沒有運行（我不明白為什么）。于是，我試著寫一個Function具有相同for的回圈利用我Sub，然后運行Function中Sub，并在“功能”（希望會做同樣的作業的Do While回圈）。
我的代碼都沒有作業，但我正在添加我的最后一次嘗試，因為建議將它放在問題上（盡管我懷疑有經驗的人是否會閱讀它，因為它寫得不好 - 加上不起作用）。
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*String2and String2*String1），這會導致創建無限回圈的問題（我沒有嘗試在我的代碼上解決這個問題，因為我不能甚至得到幾條路徑）。
請參閱下面的字串：
開始字串
-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-
連接器_字串
-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-
希望有人可以幫助我。
uj5u.com熱心網友回復：
將連接復制到名為的文本檔案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
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/409594.html
標籤：
上一篇：蟒蛇3。CSV。如何在不覆寫當前行的情況下將新行寫入csv檔案？
下一篇：從Excel加載項捕獲作業簿事件