录制宏时Excel会冻结

Question

我有一个与所有宏完全一致的现有.xlsm文件。问题是，当我尝试录制另一个宏时，我添加了一列，然后按回车，并收到消息“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%。这会调出你的临时文件。

删除全部或部分文件，重新启动计算机并重试。