Excel VBA-速度非常慢,而且行为怪异-其他正在运行的东西



ok-Excel VBA-

是不是跑得很慢,还有奇怪的行为——是不是有其他东西在跑?

  • 我键入的文本有时会自动"重新排列"(即,我键入的第一个字母会突然出现在末尾)
  • 我所在的当前行的文本全部变为红色
  • 在打字的过程中,甚至在我打字之前,一个窗口就会弹出"语法错误"

我已经关闭了插件(我有TM1,这是一个痛苦的后端)

我已经优化了我正在使用的代码,并且已经编码了很长时间,没有什么应该花这么长时间。。。

救命!!!

    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

  1. 您是否检查了Excel工作簿代码?我的意思是,工作簿中没有更新代码,VBA模块也没有。

  2. 您是否尝试在代码运行时关闭Excel recalc并显示

    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. 工作表是否已损坏?这是最后的手段,但你是否尝试过打开另一个新工作簿,并将数据和代码复制到其中,然后重新保存。我已经用它来克服不稳定的行为,尤其是在网络上有大床单的情况下。

只是想帮你找出这种令人恼火的行为。

这不一定是答案,但也许它会让你看到另一件事

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

最终的结果与您所描述的行为非常相似。当我写代码时,代码在行的中间被切断。代码变红。等等。

你有后台运行的计时器吗?

2) 我没有遇到TM1的问题,但我们的EIKON插件会导致各种奇怪的行为,比如不返回shell命令。在这种情况下,唯一有帮助的是完全删除外接程序。不仅仅是停用它。删除它!

相关内容

最新更新