Excel VBA - 非常慢,奇怪的行为 - 其他东西在运行?

时间:2015-03-28 20:13:58

标签: excel vba

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

2 个答案:

答案 0 :(得分:0)

  1. 您是否检查过 Excel工作簿代码?我的意思是你的工作簿中没有更新代码而不是你的VBA模块。

  2. 您是否尝试在代码运行时关闭 Excel重新计算并显示

    Application.Calculation = xlManual
    ' Then later setting it back to Automatic, and
    
    Application.ScreenUpdating = False
    ' Do code and stop screen flickering
    Application.ScreenUpdating = True
    
  3. 流氓Excel 版本是否已打开?即使您重新启动当前实例 - 当我在Excel 64位工作时,当另一个应用程序打开另一个Excel 32位时,我有时会遇到错误。看看任务经理。

  4. 表格是否已损坏?最后一招,但是你试过打开另一个新工作簿并将数据和代码复制到其中,然后重新开始。我已经用它来克服不稳定的行为,尤其是网络上的大页。

  5. 试着帮助你追踪这种恼人的行为。

答案 1 :(得分:0)

这不一定是答案,但也许它会给你另一件事要看。两个想法:

1)在Access中编码时,我有类似的行为。在我的特定实例中,我有一个隐藏的表单在后台运行,并链接到计时器。计时器触发的代码将检查数据库中的某些表。

最终结果与您描述的行为非常相似。在我编写代码的过程中,代码被切断了。代码变红了。等

你有没有在后台运行的计时器?

2)我没有遇到TM1的问题,但我们的EIKON加载项会导致各种奇怪的行为,例如不返回shell命令。在该实例中唯一有助于完全删除加载项的事情。不只是停用它。删除它!