VBA新手运行时提示溢出怎么修改

qq_39916329 2017-09-10 04:18:51
...全文
1524 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
赵4老师 2017-09-12
  • 打赏
  • 举报
 回复
舉杯邀明月 2017-09-11
  • 打赏
  • 举报
 回复
引用 13 楼 qq_39916329 的回复:
这个地方需要这么修改呢，能否帮忙先修改一下，我做个对比，谢谢了
我不是已经把“改好的代码”贴出来了吗！！！ 你在那个类模块中找到 parseNumber函数，把它删除、把我12楼的代码Copy过去不就行了！ 或者说： 　在12楼代码中的代码，第12到16行（原始代码“删除”），把第17行贴在那儿就行了！ 另外就是“函数类型”，它是“未指定数据类型”的（即：Variant类型），我改成Double类型了。 也可以改一下。不改对你也没多大影响。
qq_39916329 2017-09-11
  • 打赏
  • 举报
 回复
这个地方需要这么修改呢，能否帮忙先修改一下，我做个对比，谢谢了
舉杯邀明月 2017-09-11
  • 打赏
  • 举报
 回复
大概看了下。　 先把这个函数改一下吧： 
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
qq_39916329 2017-09-11
  • 打赏
  • 举报
 回复 
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
qq_39916329 2017-09-11
  • 打赏
  • 举报
 回复 
'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
舉杯邀明月 2017-09-11
  • 打赏
  • 举报
 回复
或者说：你是从哪Copy来的代码？把原网址贴出来。
舉杯邀明月 2017-09-11
  • 打赏
  • 举报
 回复
把7楼的代码，贴“文本”贴出来。 最好是用“代码块”　括起来。（回复编辑框上，第12个图标，“笑脸”左边那个，列表中后面，选 Visual Basic） 。 选了之后，注意就是把你的代码粘贴到光标处（就是代码文本贴在两个方括号括起来的“标记”中间）。
qq_39916329 2017-09-11
  • 打赏
  • 举报
 回复
跟踪进去了是这样的，下一步应该怎么操作呢
舉杯邀明月 2017-09-11
  • 打赏
  • 举报
 回复
你现在是 obj.parse(a)出错，需要它的代码才能找原因！！！！ 那个函数是什么声明形式、如何实现的，别人都不知道，能解答什么？？？？
qq_39916329 2017-09-11
  • 打赏
  • 举报
 回复
整体的代码如下拜托各位解答一下
舉杯邀明月 2017-09-11
  • 打赏
  • 举报
 回复
把你的“类1”的 parse( )函数代码贴出来。 或者，你在那一句处设置一个断点，执行到那儿中断时，按“F8”跟踪进去，看函数内是哪行代码出错。 断点设置或取消操作： 　　光标点到那行上、再按功能键“F9”；或者在你图中最左边黄色箭头处用鼠标单击。 　　左边有一个红褐色圆点、代码文字有红褐色背景，表示有断点；　否则就是没有断点。 按照你“图中的状态”，再按F8应该也能重新跟踪进去。
qq_39916329 2017-09-11
  • 打赏
  • 举报
 回复
光标在这个地方显示有问题，但我不知道怎么修改
赵4老师 2017-09-11
  • 打赏
  • 举报
 回复
注释掉所有On Error Resume Next语句，在VBA IDE中运行， 出错后点击调试，光标会停在出错的那条语句处， 或者 事先在怀疑可能有逻辑错误的语句处设置断点，运行经过断点时中断， 此时可以在立即窗口中使用 ?变量名 或 ?函数名(函数参数) 或 过程名(参数) 辅助调试。
舉杯邀明月 2017-09-10
  • 打赏
  • 举报
 回复
VBA基础编程开发课程
从0基础开始讲解VBA：VBA运行环境、VBA常用对象单元格、工作表、工作簿、常用VBA语句：IF判断语句、For循环语句、数组、字典、正则提取、数据处理、提取等等作者：陈表达  爱好：excel 的公式和VBA编程，Access数据库，SQL数据库、VB和VB.NETExcel表格作品：《VBA代码宝》、《VBA进销存系统》、《图书馆系统》、《发票凑数器》、《进销存模板表格》、《出入库系统》等等的模板表格等诸多VBA功能及技巧，熟悉VBA数组、字典、正则，函数公式，SQL、VB等,拥有多年编程经验visual studio（VB.NET）作品：《大表格工具箱》、《E达通工具箱》、《进销存系统》、《数据储存器》、《SQL题库系统》等等实际案例，职场应用，应有尽有，升职加薪不是梦，学会excel函数、VBA、ACCESS数据库等办公技能，能极大地缩短工作时间，达到高效率工作，希望能跟大家一起学习进步！
自动化错误mysql vba,c - 运行时错误-214767259（80004005）自动化错误未指定错误 - Excel VBA - UIAutomation - 堆栈内存溢出...
我对EXcel VBA有一些了解，我是UI Automation的新手。 我正在尝试使用Excel VBA在客户端环境中进行UI自动化。 我参考了UIAutomationCore.dll。 当我尝试单击应用程序上的按钮时，我收到“运行时错误-2147467256(80004005)自动化错误未指定错误”。以下是我的代码。 在最后一行，当我尝试调用该功能时，我收到错误。我使用的是Window...
编程新手导论（转载）
第二部分 导论，这一部分主要是关于编程的导论， (要懂得一点思想具备一点常识)《设计，编码，，与软工》（编程与思想）这一章解释了三种思想，原语，抽象，组合，，和软件开发的二个重要过程，，软件工程的相关概念，是编程入门的关键 (要懂得一点领域内的数学)《数学与算法》（编程与数学）计算机整个就是架构在数学上的，跟计算机平台实现，算法设计，，架构密切相关，，真正要深入编程，，，对数学的学习是必须的，
新手电脑硬件软件故障解答(二)
请问赛扬D配什么主板最好？　　问：我“五一”节前打算配机一台，请问如果要选赛扬D320，该搭配哪种类型的主板才能最大限度地发挥赛扬D的超频性能又很好地搭配Radeon 9550显卡? 另外请问赛扬D的发热量是不是很大？　　答：能与赛扬D搭配的主板很多，要想超频的话首先推荐名牌大厂的i865PE主板，现在随着9系列主板的上市，这类产品的价格已经比较低。如果要省钱的话，可以选择i848P主板，这款芯片
编程新手导论
第二部分 导论，这一部分主要是关于编程的导论， (要懂得一点思想具备一点常识)《设计，编码，，与软工》（编程与思想）这一章解释了三种思想，原语，抽象，组合，，和软件开发的二个重要过程，，软件工程的相关概念，是编程入门的关键 (要懂得一点领域内的数学)《数学与算法》（编程与数学）计算机整个就是架构在数学上的，跟计算机平台实现，算法设计，，架构密切相关，，真正要深入编程，，，对数学的学习是必须的，
VBA

2,464

社区成员

10,807

社区内容

发帖
与我相关
我的任务
社区描述
VBA（Visual Basic for Applications）是Visual Basic的一种宏语言，是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章