錄制宏時Excel凍結

Question

我有一個現有的.xlsm文件，可以與所有宏完美運行。 問題是，當我嘗試記錄另一個宏時，我添加了一列，按Enter鍵，並收到消息“ Microsoft Excel已停止響應”。 然后，我必須結束該過程。 我假設這與從Excel 2003導入並修改為適用於2010的現有宏有關。

此宏中是否存在任何不兼容問題，可能導致此問題？

 Sub Auto_Open()

    Wbname = ActiveWorkbook.Name  ' this needs to be first so the move works properly
    fileToOpen = Application.GetOpenFilename("CSV files (*.csv), *.csv", 1, "Select file to open")
    If fileToOpen <> False Then
        Workbooks.Open (fileToOpen)
    End If

    sheetname = ActiveSheet.Name

    Sheets(sheetname).Select
    Sheets(sheetname).Move Before:=Workbooks(Wbname).Sheets(1)

    Call Weekly_RTP

 End Sub

Sub Weekly_RTP()
'
' Macro recorded 01/12/12 by Robert Gagliardi
'
'   This next section (up to call sort_data) is needed until we get the formatting correct.
'   Clearing the last rows and adding misc headers will solve the short term problem
'   Need this once pivot table is created.  Can't have heading row without names in it
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Misc"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Misc1"
    Columns("N:Z").Select
    Selection.ClearContents

    Call Sort_data

    ' concat mui & object to make it easy to find dups use countifs once at excel 2007 or greater
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Junk"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RC[-7]&RC[-5]"
    Range("N2").Select
    Selection.Copy
'    need to find last row using column K2
    lastrow = ActiveSheet.Range("K2").End(xlDown).Select
'    Selection.Offset(0, 3).Select   Moves over 3 cells
    Range("N2", Selection.Offset(0, 3)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Alerts"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R2C[12]:RC15,RC[12])=1,COUNTIF(C[12],RC[12]),"" "")"
    Range("C2").Select
    Selection.Copy
'    need to find last row using column B2 since column C was just added
    lastrow = ActiveSheet.Range("B2").End(xlDown).Select
'    Selection.Offset(0, 1).Select   Moves over 1 cell from last cell in column B
    Range("C2", Selection.Offset(0, 1)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


    Call Create_pivot
    Call Save_data

'   how to select a range of cells with data in them
'    Worksheets(ActiveSheet.Name).Activate
'    ActiveCell.CurrentRegion.Select

End Sub


Sub Create_pivot()

    Wbname = ActiveWorkbook.Name

'   Insert columns to make room for pivot table
    Columns("A:I").Select
    Selection.Insert Shift:=xlToRight

    myData = Sheets(ActiveSheet.Name).[J1].CurrentRegion.Address
    mySheet = ActiveSheet.Name & "!"
    tableDest = "[" & Wbname & "]" & mySheet & "R1C1"
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        mySheet & myData).CreatePivotTable TableDestination:=tableDest, TableName _
        :="RTP_alerts", DefaultVersion:=xlPivotTableVersionCurrent
    With ActiveSheet.PivotTables("RTP_alerts").PivotFields("Application")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("RTP_alerts").PivotFields("Object")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("RTP_alerts").AddDataField ActiveSheet.PivotTables( _
        "RTP_alerts").PivotFields("Alerts"), "Count of Alerts", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    Application.CommandBars("PivotTable").Visible = False

    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Owner"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Problem Ticket"
    Columns("E:E").ColumnWidth = 13
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Comments"
    Columns("F:F").ColumnWidth = 48

End Sub

Sub Save_data()

    Filename = ActiveWorkbook.Name
    Do
        Fname = Application.GetSaveAsFilename(Filename, fileFilter:="Excel Files (*.xlsm), *.xlsm")
    Loop Until Fname <> False
    ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=52

End Sub

Sub Sort_data()

    Columns("A:M").Select
    Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Key2:=Range("I2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("A1").Select

End Sub

Answer 1

我遇到了同樣的問題，可以嘗試以下方法。 轉到start-->run ，然后在框中鍵入%temp% 。 這將顯示您的臨時文件。

刪除全部或其中一部分，重新​​啟動計算機，然后重試。