我正在嘗試創建一個決議 VBA 代碼的 VBA 函式。我正處于嘗試將一行代碼中存在的所有指令放入陣列變數的階段。例如以下代碼包含兩條指令：
strVar = "Some text"
lngVar = 2
這兩條指令也可以寫成如下：
strVar = "Some text": lngVar = 2
我指定我已經有一個將“多行”行轉換為簡單行的個人函式：
strVar = "From text": _
lngVar = 2 'Multiline'
所以我的自定義函式的 CodeLine 引數（要決議的代碼行）總是包含一個代碼行。我以為我已經達到了預期的結果，因為我通過一些扭曲的線條得到了正確的結果，例如：
str = " : 1": str = " : 2": str = " : 2"
要么
str = """ : 1""": str = """ : 2""": str = """ :"" 2""
但我意識到我沒有得到這種線的預期結果：
Next vntSubString: CommentPosition = IIf(blnStringMode, 0, InStr(1, CodeLine, ": "))
我真的很想做一些通用且快速執行的事情，我認為我離最終結果并不太遠，但我有點受阻。
這是我目前的個人功能：
Public Function SplitInstructions(ByVal CodeLine As String) As Variant()
Dim vntResult() As Variant
Dim vntSubString1 As Variant
Dim blnIsStringMode As Boolean 'Determines if we are in a subtext between quotes or not
Dim vntSubString2 As Variant
Let vntResult = VBA.Array
If InStr(1, CodeLine, ": ") = 0 Then 'A single instruction
Let vntResult = VBA.Array(CodeLine)
ElseIf InStr(1, CodeLine, """") = 0 Then 'Several statements, but no quotes => On Split
Do Until VBA.InStr(1, CodeLine, "::") = 0
Let CodeLine = VBA.Replace(CodeLine, "::", ":")
Loop: Call AddToArray(vntResult, Split(CodeLine, ":"))
Else 'it gets complicated
For Each vntSubString1 In Split(CodeLine, """")
If blnIsStringMode Then
Let vntResult(UBound(vntResult)) = Trim$(vntResult(UBound(vntResult)) & """" & vntSubString1 & """")
Else
For Each vntSubString2 In Split(vntSubString1, ": ")
If vntSubString2 <> vbNullString Then Call AddToArray(vntResult, vntSubString2)
Next vntSubString2
End If
Let blnIsStringMode = Not blnIsStringMode
Next vntSubString1
End If
Let SplitInstructions = vntResult
End Function
Private Sub AddToArray(ByRef Arr() As Variant, ByVal Value As Variant)
Dim vntValue As Variant
If VBA.IsArray(Value) Then
For Each vntValue In Value
Call AddToArray(Arr, vntValue)
Next vntValue
Else
ReDim Preserve Arr(LBound(Arr) To UBound(Arr) 1)
Let Arr(UBound(Arr)) = Value
End If
End Sub
在此先感謝您的幫助！
編輯：這是我用來確定代碼行的注釋位置的函式
Private Function CommentPosition(ByVal CodeLine As String) As Long
Dim vntSubString As Variant
Dim blnStringMode As Boolean
Dim x As Long
For Each vntSubString In VBA.Split(CodeLine, """")
If Not blnStringMode Then
Let x = VBA.InStr(1, vntSubString, "'")
If x > 0 Then
Let CommentPosition = CommentPosition x
Exit Function
End If
End If
Let blnStringMode = Not blnStringMode
Let CommentPosition = CommentPosition VBA.Len(vntSubString) 1
Next vntSubString
Let CommentPosition = VBA.IIf(blnStringMode, 0, VBA.InStr(1, CodeLine, "'"))
End Function
uj5u.com熱心網友回復：
以 Dick 的答案為基礎來決議字串，但利用InStr來展望下一個感興趣的字符：
Sub test()
Dim CodeLine As String
Dim CodeLines() As String
CodeLine = "str = """""" : 1"""""": str = """""" : 2"""""": str = """""" :"""" 2"""""
CodeLines = SplitInstructions(CodeLine)
Stop
End Sub
Function SplitInstructions(ByVal CodeLine As String) As String()
Dim CharOfInterest As String
Dim idx As Long
Dim aReturn() As String
Dim NumLines As Long
ReDim aReturn(1 To 1000)
NumLines = 1
aReturn(1) = CodeLine
idx = 1
Do
Debug.Print aReturn(NumLines), idx
CharOfInterest = GetNextCharOfInterest(aReturn(NumLines), idx)
Select Case CharOfInterest
Case """"
' Ignore remainder of quoted string
idx = GetStringClose(aReturn(NumLines), idx) 1
Case ":"
' Break on :
aReturn(NumLines 1) = Trim$(Mid$(aReturn(NumLines), idx 1))
aReturn(NumLines) = Trim$(Left$(aReturn(NumLines), idx - 1))
NumLines = NumLines 1
idx = 1
Case "'", vbNullString
' Comment, or end of code
ReDim Preserve aReturn(1 To NumLines)
Exit Do
End Select
Loop
SplitInstructions = aReturn
End Function
' Look ahead to end of Quoted string
Function GetStringClose(CodeLine As String, ByRef idx As Long)
Dim i As Long
If Mid$(CodeLine, idx, 1) = """" Then 'verfiy
i = InStr(idx 1, CodeLine, """")
Do
If Mid$(CodeLine, i 1, 1) = """" Then
' delimited "
i = i 1
i = InStr(i 1, CodeLine, """")
Else
' end of quoted string
i = IIf(i = 0, Len(CodeLine) 1, i)
GetStringClose = i
Exit Do
End If
Loop
Else
'invalid call
Stop
End If
End Function
Function GetNextCharOfInterest(CodeLine As String, idx As Long) As String
Dim Quote As Long
Dim Colon As Long
Dim Comment As Long
Dim MinPos As Long
If idx > Len(CodeLine) Then
GetNextCharOfInterest = vbNullString
Exit Function
End If
Quote = InStr(idx, CodeLine, """")
Colon = InStr(idx, CodeLine, ":")
Comment = InStr(idx, CodeLine, "'")
If Quote Colon Comment = 0 Then
GetNextCharOfInterest = vbNullString
Else
Quote = IIf(Quote = 0, Len(CodeLine) 1, Quote)
Colon = IIf(Colon = 0, Len(CodeLine) 1, Colon)
Comment = IIf(Comment = 0, Len(CodeLine) 1, Comment)
MinPos = Application.Min(Quote, Colon, Comment)
If Quote = MinPos Then
GetNextCharOfInterest = """"
idx = Quote
ElseIf Colon = MinPos Then
GetNextCharOfInterest = ":"
idx = Colon
Else
GetNextCharOfInterest = "'"
idx = Comment
End If
End If
End Function
測驗結果
uj5u.com熱心網友回復：
如果你想用雙引號分開，你需要確定你是否在一組括號內并將所有這些放在一起。我認為這是很多作業。如果您只是按順序遍歷字串怎么辦？
Public Function SplitInstructions2(ByVal CodeLine As String) As String()
Dim i As Long
Dim lLastPos As Long
Dim aReturn() As String
Dim bInString As Boolean
Dim lCnt As Long
ReDim aReturn(1 To 1000)
lLastPos = 1
For i = 1 To Len(CodeLine)
If Mid$(CodeLine, i, 1) = ":" And Not bInString Then
lCnt = lCnt 1
aReturn(lCnt) = Trim$(Mid$(CodeLine, lLastPos, i - lLastPos))
lLastPos = i 1
ElseIf Mid$(CodeLine, i, 1) = """" Then
bInString = Not bInString
End If
Next i
lCnt = lCnt 1
aReturn(lCnt) = Trim$(Mid$(CodeLine, lLastPos, Len(CodeLine) - lLastPos 1))
ReDim Preserve aReturn(1 To lCnt)
SplitInstructions2 = aReturn
End Function
uj5u.com熱心網友回復：
我不斷地挖掘，找到了一條路。它可能可以增強，但這里是完整的代碼：
Option Explicit
Public Sub DurationTest()
Dim StartTime As Single
Dim Count As Long
Dim vntCodeLine As Variant
Dim vntInstructions() As Variant
Let StartTime = VBA.Timer
For Count = 1 To 100000
For Each vntCodeLine In VBA.Array( _
"str = "" : 1"": str = "" : 2"": str = "" : 2""", _
"var = 2: var = 2", _
"str = """""" : 1"""""": str = "" """": 2"""""": str = "" """":"""" 2""", _
"Next vntSubString: CommentPosition = IIf(blnStringMode, 0, InStr(1, CodeLine, "": ""))")
Let vntInstructions = SplitInstructions(vntCodeLine)
Next vntCodeLine
Next Count
Call VBA.MsgBox("Solution 1: " & VBA.Timer - StartTime)
Let StartTime = VBA.Timer
For Count = 1 To 100000
For Each vntCodeLine In VBA.Array( _
"str = "" : 1"": str = "" : 2"": str = "" : 2""", _
"var = 2: var = 2", _
"str = """""" : 1"""""": str = "" """": 2"""""": str = "" """":"""" 2""", _
"Next vntSubString: CommentPosition = IIf(blnStringMode, 0, InStr(1, CodeLine, "": ""))")
Let vntInstructions = SplitInstructions2(vntCodeLine)
Next vntCodeLine
Next Count
Call VBA.MsgBox("Solution 2: " & VBA.Timer - StartTime)
End Sub
Public Function SplitInstructions(ByVal CodeLine As String) As Variant() 'Use Split function, faster than SplitInstructions2
Dim vntResult() As Variant
Dim vntSubString As Variant
Dim blnStringMode As Boolean
Dim x As Long, y As Long
Dim lngStart As Long
Let vntResult = VBA.Array
If VBA.InStr(1, CodeLine, """") = 0 Then
For Each vntSubString In VBA.Split(CodeLine, ":")
Let vntSubString = VBA.Trim$(ReplaceAll(vntSubString, "::", ":"))
If vntSubString <> VBA.vbNullString Then Call AddToArray(vntResult, vntSubString)
Next vntSubString
ElseIf VBA.InStr(1, CodeLine, ": ") = 0 Then
Let vntSubString = VBA.Trim$(ReplaceAll(CodeLine, "::", ":"))
If vntSubString <> VBA.vbNullString Then Call AddToArray(vntResult, vntSubString)
Else
For Each vntSubString In VBA.Split(CodeLine, """")
If Not blnStringMode Then
Let x = VBA.InStr(1, vntSubString, ":")
If x > 0 Then
Call AddToArray(vntResult, VBA.Mid$(CodeLine, lngStart 1, x y - lngStart - 1))
Let lngStart = y VBA.InStrRev(vntSubString, ":") 1
End If
End If
Let blnStringMode = Not blnStringMode
Let y = y VBA.Len(vntSubString) 1
Next vntSubString
If x y - lngStart - 1 > 0 Then
Call AddToArray(vntResult, VBA.Mid$(CodeLine, lngStart 1, x y - lngStart - 1))
End If
End If
Let SplitInstructions = vntResult
End Function
Public Function SplitInstructions2(ByVal CodeLine As String) As Variant() 'Sequential iterations, slower than SplitInstructions
Dim vntResult() As Variant
Dim lngStart As Long, k As Long
Dim blnStringMode As Boolean
Let vntResult = VBA.Array
Let lngStart = 1
For k = 1 To VBA.Len(CodeLine)
If VBA.Mid$(CodeLine, k, 1) = """" Then
Let blnStringMode = Not blnStringMode
ElseIf VBA.Mid$(CodeLine, k, 1) = ":" Then
If Not blnStringMode Then
If k > lngStart Then Call AddToArray(vntResult, VBA.Trim$(VBA.Mid$(CodeLine, lngStart, k - lngStart)))
Let lngStart = k 1: End If
End If
Next k
If k > lngStart Then Call AddToArray(vntResult, VBA.Trim$(VBA.Mid$(CodeLine, lngStart, k - lngStart)))
Let SplitInstructions2 = vntResult
End Function
Private Sub AddToArray(ByRef Arr() As Variant, ByVal Value As Variant)
Dim vntValue As Variant
If VBA.IsArray(Value) Then
For Each vntValue In Value
Call AddToArray(Arr, vntValue)
Next vntValue
Else
ReDim Preserve Arr(LBound(Arr) To UBound(Arr) 1)
Let Arr(UBound(Arr)) = Value
End If
End Sub
Public Function ReplaceAll(ByVal Expression As String, ByVal Find As String, ByVal Replace As String) As String
Do Until VBA.InStr(1, Expression, Find) = 0
Let Expression = VBA.Replace(Expression, Find, Replace)
Loop: Let ReplaceAll = Expression
End Function
謝謝你讀我。大家保重。
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/441757.html
下一篇：Java二維陣列語法包裝邊框