ok - Excel VBA -
运行速度非常慢,行为奇怪 - 还有其他东西在运行吗?
我关掉了插件(我有TM1 - 这是后端的痛苦)
我已经优化了我正在使用的代码,并且已经编写了很长时间,并且没有什么可以花这么长时间......
HELP !!!
Sub CreateCopy3()
Dim x As Long
Dim sumFilterNo As Long
Dim m As Long
Dim DelMe As Long
Dim nCount As Long
Dim lRowC_DoW
Dim newSh As String
Dim mp As Long
Dim shDoW
Dim shData As String
Dim shCons As String
Dim shXX As String
Dim shDoWXX As String
Dim sFilter As String
Dim sFilterCol As String
Dim sFilterColNumber As Long
Dim shName As String
Dim sFilterBy As String
Dim lRowC As Long
Dim lRowC_Sum As Long
Dim lRowC_new As Long
Dim niceName As String
Dim l As Long
Dim RptFilteredBy As String
Dim lLastRow As Long, lLastColumn As Long
Dim lRealLastRow As Long, lRealLastColumn As Long
Dim arrAgent() As String
Dim j As Long
Application.ScreenUpdating = False
shDoWXX = "DOW XX"
shXX = "ZZ"
shData = "Data"
shCons = "Consolidated"
Sheets("Summary").Select
sFilter = Range("B2").Value
sFilterBy = Range("B3").Value
lRowC = ActiveSheet.UsedRange.Rows.Count - 11
Select Case sFilter
Case "AGENT_CODE"
shName = "Agent"
sFilterCol = "J"
sumFilterNo = 1
niceName = "Agent Code"
sFilterColNumber = 1
Case "ACCOUNT_MANAGER"
sFilterCol = "F"
shName = "AM"
sumFilterNo = 5
niceName = "Account Manager"
sFilterColNumber = 30
Case "Regional_Sales_Manager"
sFilterCol = "G"
sumFilterNo = 6
shName = "SM"
sFilterColNumber = 31
niceName = "Reg. Sales Manager"
Case "Customer"
shName = "Customer"
sFilterCol = "I"
sumFilterNo = 9
niceName = "Customer"
sFilterColNumber = 33
Case "Region"
shName = "Region"
sFilterCol = "C"
sumFilterNo = 2
niceName = "Region"
sFilterColNumber = 29
Case "Top_Level_Region"
sumFilterNo = 1
shName = "Top Region"
sFilterCol = "B"
niceName = "Top Level Region"
sFilterColNumber = 28
Case Else
MsgBox "No Selection - operation cancelled"
Exit Sub
End Select
RptFilteredBy = niceName & " filtered by " & Range("B3").Value
Range("B9").Value = RptFilteredBy
Application.DisplayAlerts = False
Worksheets(shData).Activate
lRowC = ActiveSheet.UsedRange.Rows.Count
Sheets("Summary").Select
'Range("A13:Z" & lRowC).Clear
If ActiveSheet.AutoFilterMode = True Then
' Range("A3:AZ3").Select
Selection.AutoFilter
End If
Range("A13:Z" & lRowC).Clear
Worksheets(shCons).Activate
If ActiveSheet.AutoFilterMode = False Then
Range("A3:AZ3").Select
Selection.AutoFilter
End If
If ActiveSheet.AutoFilterMode = True Then
Range("A3:AZ3").Select
Selection.AutoFilter
End If
If ActiveSheet.AutoFilterMode = False Then
Range("A3:AZ3").Select
Selection.AutoFilter
End If
ActiveSheet.Range("$A$3:$AZ$" & lRowC).AutoFilter Field:=sFilterColNumber, Criteria1:= _
sFilterBy, Operator:=xlAnd
Range("G11").Select
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Summary").Select
Range("A12").Activate
Range("B1").FormulaR1C1 = "=COUNTA(R[12]C[-1]:R[" & lRowC & "]C[-1])"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$13:$A$" & lRowC + 10 & "").RemoveDuplicates Columns:=1, Header:=xlNo
Range("B13").Select
'**************** remove errors **********************
If ActiveSheet.AutoFilterMode = True Then
Range("A12:AZ12").Select
Selection.AutoFilter
End If
Application.StatusBar = "Calculations for summary page"
lRowC_Sum = Range("B1").Value + 12
If lRowC_Sum < 13 Then lRowC_Sum = 13
Range("B13").Activate
Range("B13:C" & lRowC & ",E13:M1" & lRowC & "").FormulaR1C1 = _
"=INDEX(Consolidated!R3C1:R" & lRowC & "C73,MATCH(RC1,Consolidated!C1,0),MATCH(R5C,Consolidated!R3C1:R3C53,0))"
'
Range("B13:Z" & lRowC).Value = Range("B13:Z" & lRowC).Value
Range("D13:D" & lRowC).FormulaR1C1 = "=""VS""&LEFT(RC[-3],4)"
Range("d13:d" & lRowC).Value = Range("d13:d" & lRowC).Value
Range("O13:O" & lRowC).FormulaR1C1 = "=COUNTIF(Consolidated!C1,RC1)"
Range("Q13:Q" & lRowC).FormulaR1C1 = "=SUMIF(Consolidated!C1,RC1,Consolidated!C[-4])"
Range("R13:R" & lRowC).FormulaR1C1 = "=SUMIF(Consolidated!C1,RC1,Consolidated!C[-4])"
Range("P13:P" & lRowC).FormulaR1C1 = "=SUM(RC[1]:RC[2])"
Range("S13:S" & lRowC).FormulaR1C1 = "=RC[-1]/RC[-4]"
Range("T13:T" & lRowC).FormulaR1C1 = "=SUMIF(Consolidated!C1,RC1,Consolidated!C[-4])"
Range("U13:U" & lRowC).FormulaR1C1 = "=SUMIF(Consolidated!C1,RC1,Consolidated!C[-3])"
Range("V13:V" & lRowC).FormulaR1C1 = "=RC[-1]/RC[-2]"
Range("W13:W" & lRowC).FormulaR1C1 = "=SUMIF(Consolidated!C1,RC1,Consolidated!C[-6])"
Range("X13:X" & lRowC).FormulaR1C1 = "=SUMIF(Consolidated!C1,RC1,Consolidated!C[-5])"
Range("Y13:Y" & lRowC).FormulaR1C1 = "=RC[-1]/RC[-2]"
Range("O10").FormulaR1C1 = "=SUM(R[3]C:R[" & lRowC_Sum & "]C)"
Range("P10").FormulaR1C1 = "=SUM(R[3]C:R[" & lRowC_Sum & "]C)"
Range("Q10").FormulaR1C1 = "=SUM(R[3]C:R[" & lRowC_Sum & "]C)"
Range("R10").FormulaR1C1 = "=SUM(R[3]C:R[" & lRowC_Sum & "]C)"
Range("S10").FormulaR1C1 = "=SUM(RC[-2]/RC[-4])"
Range("T10").FormulaR1C1 = "=SUM(R[3]C:R[" & lRowC_Sum & "]C)"
Range("U10").FormulaR1C1 = "=SUM(R[3]C:R[" & lRowC_Sum & "]C)"
Range("V10").FormulaR1C1 = "=SUM(RC[-1]/RC[-2])"
Range("W10").FormulaR1C1 = "=SUM(R[3]C:R[" & lRowC_Sum & "]C)"
Range("X10").FormulaR1C1 = "=SUM(R[3]C:R[" & lRowC_Sum & "]C)"
Range("Y10").FormulaR1C1 = "=SUM(RC[-1]/RC[-2])"
Range("X13").Select
Range("B13:DA" & lRowC_Sum).NumberFormat = "#,###;[Red](#,###)"
Range("S13:S" & lRowC_Sum).Style = "Percent"
Range("V13:V" & lRowC_Sum).Style = "Percent"
Range("Y13:Y" & lRowC_Sum).Style = "Percent"
Range("N13:N" & lRowC_Sum).NumberFormat = "0"
Range("K13:K" & lRowC_Sum).NumberFormat = "0"
Application.Calculation = xlCalculationAutomatic
Range("B1").FormulaR1C1 = "=COUNTA(R[12]C[1]:R[" & lRowC & "]C[1])"
lRowC = Range("B1").Value
Range("A12:AZ12").Select
'**************** remove errors **********************
If ActiveSheet.AutoFilterMode = False Then
Range("A12:AZ12").Select
Selection.AutoFilter
End If
On Error Resume Next
ActiveSheet.Range("$A$12:$AZ" & lRowC_Sum).AutoFilter Field:=2, Criteria1:="#N/A"
On Error GoTo 0
Application.Calculation = xlCalculationManual
Range("A12").Select
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then Exit Do
Loop Until ActiveCell.EntireRow.Hidden = False
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
If ActiveSheet.AutoFilterMode = True Then
Selection.AutoFilter
End If
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If
On Error Resume Next
ActiveSheet.Range("$A$12:$AZ$" & lRowC_Sum).AutoFilter Field:=13, Criteria1:="0"
On Error GoTo 0
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then Exit Do
Loop Until ActiveCell.EntireRow.Hidden = False
Range("G2").Select
'**************** errors removed **********************
Application.StatusBar = "Formatting...."
Range("B1").FormulaR1C1 = "=COUNTA(R[12]C[1]:R[" & lRowC & "]C[1])"
lRowC = Range("B1").Value
Application.StatusBar = ""
MsgBox "Summary Reports Created for " & vbCrLf & niceName & " " & sFilterBy
Application.ScreenUpdating = False
End Sub
答案 0 :(得分:0)
您是否检查过 Excel工作簿代码?我的意思是你的工作簿中没有更新代码而不是你的VBA模块。
您是否尝试在代码运行时关闭 Excel重新计算并显示?
Application.Calculation = xlManual
' Then later setting it back to Automatic, and
Application.ScreenUpdating = False
' Do code and stop screen flickering
Application.ScreenUpdating = True
流氓Excel 版本是否已打开?即使您重新启动当前实例 - 当我在Excel 64位工作时,当另一个应用程序打开另一个Excel 32位时,我有时会遇到错误。看看任务经理。
表格是否已损坏?最后一招,但是你试过打开另一个新工作簿并将数据和代码复制到其中,然后重新开始。我已经用它来克服不稳定的行为,尤其是网络上的大页。
试着帮助你追踪这种恼人的行为。
答案 1 :(得分:0)
这不一定是答案,但也许它会给你另一件事要看。两个想法:
1)在Access中编码时,我有类似的行为。在我的特定实例中,我有一个隐藏的表单在后台运行,并链接到计时器。计时器触发的代码将检查数据库中的某些表。
最终结果与您描述的行为非常相似。在我编写代码的过程中,代码被切断了。代码变红了。等
你有没有在后台运行的计时器?
2)我没有遇到TM1的问题,但我们的EIKON加载项会导致各种奇怪的行为,例如不返回shell命令。在该实例中唯一有助于完全删除加载项的事情。不只是停用它。删除它!