我有一个现有的 .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