uj5u.com熱心網友回復：
uj5u.com熱心網友回復：
注釋掉所有On Error Resume Next陳述句，在VBA IDE中運行，出錯后點擊除錯，游標會停在出錯的那條陳述句處，
或者
事先在懷疑可能有邏輯錯誤的陳述句處設定斷點，運行經過斷點時中斷，
此時可以在立即視窗中使用
?變數名
或
?函式名(函式引數)
或
程序名(引數)
輔助除錯。
uj5u.com熱心網友回復：
游標在這個地方顯示有問題，但我不知道怎么修改
uj5u.com熱心網友回復：
把你的“類1”的 parse( )函式代碼貼出來。或者，你在那一句處設定一個斷點，執行到那兒中斷時，按“F8”跟蹤進去，看函式內是哪行代碼出錯。
斷點設定或取消操作：
游標點到那行上、再按功能鍵“F9”；或者在你圖中最左邊黃色箭頭處用滑鼠單擊。
左邊有一個紅褐色圓點、代碼文字有紅褐色背景，表示有斷點； 否則就是沒有斷點。
按照你“圖中的狀態”，再按F8應該也能重新跟蹤進去。
uj5u.com熱心網友回復：
整體的代碼如下
拜托各位解答一下
uj5u.com熱心網友回復：
你現在是 obj.parse(a)出錯，需要它的代碼才能找原因！！！！
那個函式是什么宣告形式、如何實作的，別人都不知道，能解答什么？？？？
uj5u.com熱心網友回復：
跟蹤進去了是這樣的，下一步應該怎么操作呢
uj5u.com熱心網友回復：
把7樓的代碼，貼“文本”貼出來。最好是用“代碼塊” 括起來。（回復編輯框上，第12個圖示，“笑臉”左邊那個，串列中后面，選 Visual Basic） 。
選了之后，注意就是把你的代碼粘貼到游標處（就是代碼文本貼在兩個方括號括起來的“標記”中間）。
uj5u.com熱心網友回復：
或者說：你是從哪Copy來的代碼？把原網址貼出來。
uj5u.com熱心網友回復：
'Option Explicit
Const INVALID_JSON As Long = 1
Const INVALID_OBJECT As Long = 2
Const INVALID_ARRAY As Long = 3
Const INVALID_BOOLEAN As Long = 4
Const INVALID_NULL As Long = 5
Const INVALID_KEY As Long = 6
Public Function parse(ByRef str As String) As Object
Dim index As Long
index = 1
Call skipChar(str, index)
Select Case Mid(str, index, 1)
Case "{"
Set parse = parseObject(str, index)
Case "["
Set parse = parseArray(str, index)
End Select
End Function
Private Function parseObject(ByRef str As String, ByRef index As Long) As Object
Set parseObject = CreateObject("Scripting.Dictionary")
Call skipChar(str, index)
If Mid(str, index, 1) <> "{" Then Err.Raise vbObjectError + INVALID_OBJECT, Description:="char " & index & " : " & Mid(str, index)
index = index + 1
Do
Call skipChar(str, index)
If "}" = Mid(str, index, 1) Then
index = index + 1
Exit Do
ElseIf "," = Mid(str, index, 1) Then
index = index + 1
Call skipChar(str, index)
End If
Dim key As String
parseObject.Add key:=parseKey(str, index), Item:=parseValue(str, index)
Loop
End Function
Private Function parseArray(ByRef str As String, ByRef index As Long) As Collection
Set parseArray = New Collection
Call skipChar(str, index)
If Mid(str, index, 1) <> "[" Then Err.Raise vbObjectError + INVALID_ARRAY, Description:="char " & index & " : " + Mid(str, index)
index = index + 1
Do
Call skipChar(str, index)
If "]" = Mid(str, index, 1) Then
index = index + 1
Exit Do
ElseIf "," = Mid(str, index, 1) Then
index = index + 1
Call skipChar(str, index)
End If
parseArray.Add parseValue(str, index)
Loop
End Function
Private Function parseValue(ByRef str As String, ByRef index As Long)
Call skipChar(str, index)
Select Case Mid(str, index, 1)
Case "{"
Set parseValue = parseObject(str, index)
Case "["
Set parseValue = parseArray(str, index)
Case """", "'"
parseValue = parseString(str, index)
Case "t", "f"
parseValue = parseBoolean(str, index)
Case "n"
parseValue = parseNull(str, index)
Case Else
parseValue = parseNumber(str, index)
End Select
End Function
uj5u.com熱心網友回復：
Private Function parseString(ByRef str As String, ByRef index As Long) As String
Dim quote As String
Dim char As String
Dim code As String
Call skipChar(str, index)
quote = Mid(str, index, 1)
index = index + 1
Do While index > 0 And index <= Len(str)
char = Mid(str, index, 1)
Select Case (char)
Case "\"
index = index + 1
char = Mid(str, index, 1)
Select Case (char)
Case """", "\\", "/"
parseString = parseString & char
index = index + 1
Case "b"
parseString = parseString & vbBack
index = index + 1
Case "f"
parseString = parseString & vbFormFeed
index = index + 1
Case "n"
parseString = parseString & vbNewLine
index = index + 1
Case "r"
parseString = parseString & vbCr
index = index + 1
Case "t"
parseString = parseString & vbTab
index = index + 1
Case "u"
index = index + 1
code = Mid(str, index, 4)
parseString = parseString & ChrW(Val("&h" + code))
index = index + 4
End Select
Case quote
index = index + 1
Exit Function
Case Else
parseString = parseString & char
index = index + 1
End Select
Loop
End Function
Private Function parseNumber(ByRef str As String, ByRef index As Long)
Dim value As String
Dim char As String
Call skipChar(str, index)
Do While index > 0 And index <= Len(str)
char = Mid(str, index, 1)
If InStr("+-0123456789.eE", char) Then
value = value & char
index = index + 1
Else
If InStr(value, ".") Or InStr(value, "e") Or InStr(value, "E") Then
parseNumber = CDbl(value)
Else
parseNumber = CLng(value)
End If
Exit Function
End If
Loop
End Function
Private Function parseBoolean(ByRef str As String, ByRef index As Long) As Boolean
Call skipChar(str, index)
If Mid(str, index, 4) = "true" Then
parseBoolean = True
index = index + 4
ElseIf Mid(str, index, 5) = "false" Then
parseBoolean = False
index = index + 5
Else
Err.Raise vbObjectError + INVALID_BOOLEAN, Description:="char " & index & " : " & Mid(str, index)
End If
End Function
Private Function parseNull(ByRef str As String, ByRef index As Long)
Call skipChar(str, index)
If Mid(str, index, 4) = "null" Then
parseNull = Null
index = index + 4
Else
Err.Raise vbObjectError + INVALID_NULL, Description:="char " & index & " : " & Mid(str, index)
End If
End Function
Private Function parseKey(ByRef str As String, ByRef index As Long) As String
Dim dquote As Boolean
Dim squote As Boolean
Dim char As String
Call skipChar(str, index)
Do While index > 0 And index <= Len(str)
char = Mid(str, index, 1)
Select Case (char)
Case """"
dquote = Not dquote
index = index + 1
If Not dquote Then
Call skipChar(str, index)
If Mid(str, index, 1) <> ":" Then
Err.Raise vbObjectError + INVALID_KEY, Description:="char " & index & " : " & parseKey
End If
End If
Case "'"
squote = Not squote
index = index + 1
If Not squote Then
Call skipChar(str, index)
If Mid(str, index, 1) <> ":" Then
Err.Raise vbObjectError + INVALID_KEY, Description:="char " & index & " : " & parseKey
End If
End If
Case ":"
If Not dquote And Not squote Then
index = index + 1
Exit Do
End If
Case Else
If InStr(vbCrLf & vbCr & vbLf & vbTab & " ", char) Then
Else
parseKey = parseKey & char
End If
index = index + 1
End Select
Loop
End Function
Public Sub skipChar(ByRef str As String, ByRef index As Long)
While index > 0 And index <= Len(str) And InStr(vbCrLf & vbCr & vbLf & vbTab & " ", Mid(str, index, 1))
index = index + 1
Wend
End Sub
Public Function toString(ByRef obj As Variant) As String
Select Case VarType(obj)
Case vbNull
toString = "null"
Case vbDate
toString = """" & CStr(obj) & """"
Case vbString
toString = """" & encode(obj) & """"
Case vbObject
Dim bFI, i
bFI = True
If TypeName(obj) = "Dictionary" Then
toString = toString & "{"
Dim keys
keys = obj.keys
For i = 0 To obj.Count - 1
If bFI Then bFI = False Else toString = toString & ","
Dim key
key = keys(i)
toString = toString & """" & key & """:" & toString(obj(key))
Next i
toString = toString & "}"
ElseIf TypeName(obj) = "Collection" Then
toString = toString & "["
Dim value
For Each value In obj
If bFI Then bFI = False Else toString = toString & ","
toString = toString & toString(value)
Next value
toString = toString & "]"
End If
Case vbBoolean
If obj Then toString = "true" Else toString = "false"
Case vbVariant, vbArray, vbArray + vbVariant
Dim sEB
toString = multiArray(obj, 1, "", sEB)
Case Else
toString = Replace(obj, ",", ".")
End Select
End Function
Private Function encode(str) As String
Dim i, j, aL1, aL2, c, p
aL1 = Array(&H22, &H5C, &H2F, &H8, &HC, &HA, &HD, &H9)
aL2 = Array(&H22, &H5C, &H2F, &H62, &H66, &H6E, &H72, &H74)
For i = 1 To Len(str)
p = True
c = Mid(str, i, 1)
For j = 0 To 7
If c = Chr(aL1(j)) Then
encode = encode & "\" & Chr(aL2(j))
p = False
Exit For
End If
Next
If p Then
Dim a
a = AscW(c)
If a > 31 And a < 127 Then
encode = encode & c
ElseIf a > -1 Or a < 65535 Then
encode = encode & "\u" & String(4 - Len(Hex(a)), "0") & Hex(a)
End If
End If
Next
End Function
Private Function multiArray(aBD, iBC, sPS, ByRef sPT)
Dim iDU, iDL, i
On Error Resume Next
iDL = LBound(aBD, iBC)
iDU = UBound(aBD, iBC)
Dim sPB1, sPB2
If Err.Number = 9 Then
sPB1 = sPT & sPS
For i = 1 To Len(sPB1)
If i <> 1 Then sPB2 = sPB2 & ","
sPB2 = sPB2 & Mid(sPB1, i, 1)
Next
multiArray = multiArray & toString(aBD(sPB2))
Else
sPT = sPT & sPS
multiArray = multiArray & "["
For i = iDL To iDU
multiArray = multiArray & multiArray(aBD, iBC + 1, i, sPT)
If i < iDU Then multiArray = multiArray & ","
Next
multiArray = multiArray & "]"
sPT = Left(sPT, iBC - 2)
End If
Err.Clear
End Function
uj5u.com熱心網友回復：
大概看了下。
先把這個函式改一下吧：
Private Function parseNumber(ByRef str As String, ByRef index As Long) As Double
Dim value As String
Dim char As String
Call skipChar(str, index)
Do While index > 0 And index <= Len(str)
char = Mid(str, index, 1)
If InStr("+-0123456789.eE", char) Then
value = value & char
index = index + 1
Else
'If InStr(value, ".") Or InStr(value, "e") Or InStr(value, "E") Then
' parseNumber = CDbl(value)
'Else
' parseNumber = CLng(value)
'End If
parseNumber = CDbl(value)
Exit Function
End If
Loop
End Function
uj5u.com熱心網友回復：
這個地方需要這么修改呢，能否幫忙先修改一下，我做個對比，謝謝了uj5u.com熱心網友回復：
我不是已經把“改好的代碼”貼出來了嗎！！！
你在那個類模塊中找到 parseNumber函式，把它洗掉、把我12樓的代碼Copy過去不就行了！
或者說：
在12樓代碼中的代碼，第12到16行（原始代碼“洗掉”），把第17行貼在那兒就行了！
另外就是“函式型別”，它是“未指定資料型別”的（即：Variant型別），我改成Double型別了。
也可以改一下。不改對你也沒多大影響。
uj5u.com熱心網友回復：
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/54325.html
標籤：VBA