为什么下面的代码导致excel崩溃?

时间:2015-05-29 14:36:37

标签: arrays vba excel-vba excel

介绍和问题:

循环遍历活动表的列,如果有标题,则要求用户继续重新定义数组,并更改其值。

即使在注释掉数组填充的部分之后,它仍然会崩溃excel。请告诉我你对这个问题的通知和意见。

关于代码:

这是vba脚本的种子,它将根据创建的数组中的值重新排列不同工作表中的列,因此在activesheet中找到的每个列表示将保存在数组中并用于修复的列的正确顺序特定工作表中列的顺序。

我应该提到活动表中没有很多行 因此,数组长度为100-200个元素,可以长达10个字母。

 Sub deleteColumns()
            Dim PolyArr(), PointArr(), LineArr(), autoTitle As String
            Dim crntTitle As Variant
            Dim crntRow, CrntClmn, LastRow, LastClmn As Long
            Set Wizard = ActiveSheet



  With Wizard
            LastClmn = .Cells(1, .Columns.Count).End(xlToLeft).Column
            LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

            For CrntClmn = 1 To LastClmn
                If Len(Str(.Cells(1,CrntClmn).Value)) <> 0 Then
                    MSG1 = MsgBox("Column Index of '" & Str(.Cells(1,CrntClmn).Value) & "' . Do you wish to proceed?", vbYesNo, "Confirmation")
                        If MSG1 = vbYes Then
                            'ReDim PolyArr(Int(LastRow - 1))
                            'PolyArr = .Range("c2:c" & LastRow).Value
                        End If
                    End If
                Next CrntClmn
            End With

            'For Each CrntClmn In clmnArr


                For Each crntRow In PolyArr()
                    MsgBox (CStr(crntRow))
                Next crntRow

            'Next CrntClmn
        End Sub


**EDIT**:

I so the cause of the crash is 

    MSG1 = MsgBox("Column Index of '" & Str(.Cells(CrntClmn, 1).Value) & "' . Do you wish to proceed?", vbYesNo, "Confirmation")
                            If MSG1 = vbYes Then
                            End If

I removed the asking for user part making the code look like this:

    Sub deleteColumns()
        On Error GoTo Local_Err
        MsgBox ("hi world")
        Dim PolyArr(), autoTitle As String
        Dim crntTitle As Variant
        Dim crntRow, CrntClmn, LastRow, LastClmn As Long
        Set Wizard = ActiveSheet
        MsgBox ("hiwirld")
        With Wizard
            LastClmn = .Cells(1, .Columns.Count).End(xlToLeft).Column
            LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
       MsgBox ("hiwrld" & Str(LastClmn) & Str(LastRow))
            For CrntClmn = 1 To LastClmn
                MsgBox ("hidon" & Str(CrntClmn))
                If Len(.Cells(CrntClmn, 1).Value) <> 0 Then

                MsgBox ("hidonduck" & Str(CrntClmn))
                    'MSG1 = MsgBox("Column Index of '" & Str(.Cells(CrntClmn, 1).Value) & "' . Do you wish to proceed?", vbYesNo, "Confirmation")
                    'If MSG1 = vbYes Then
                        ReDim PolyArr(Int(LastRow - 1))
                        PolyArr = .Range("c2:c" & LastRow).Value
    1                'End If
                End If
            Next CrntClmn
        End With

        'For Each CrntClmn In clmnArr


            'For Each crntRow In PolyArr()
                'MsgBox (CStr(crntRow))
            'Next crntRow

        'Next CrntClmn

    Local_Exit:
        Exit Sub

    Local_Err:
        MsgBox ex & " " & Err.Description ' use ctrl-Break
        Resume Local_Exit
        Resume ' set next statement here to goto line in error
    End Sub

它现在有效,还为什么我不能在那里运行msgbox?

2 个答案:

答案 0 :(得分:1)

不是答案,而是长篇评论......

使用和错误处理程序:

Sub deleteColumns()
On Error GoTo Local_Err

'    <your code>

Local_Exit:
    Exit Sub

Local_Err:
    MsgBox ex & " " & Err.Description ' use ctrl-Break
    Resume Local_Exit
    Resume ' set next statement here to goto line in error
End Sub

运行代码以查看错误。使用Ctrl-Break转到IDE并将下一个语句设置为Resume。

答案 1 :(得分:0)

问题出在使用Str(Wizard.Cells(1,CrntClmn)的行中,删除Str()之后:Wizard.Cells(1,CrntClmn)代码运行完美!