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
-
您是否检查了Excel工作簿代码?我的意思是,工作簿中没有更新代码,VBA模块也没有。
-
您是否尝试在代码运行时关闭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
-
是否打开了流氓Excel版本?即使你重新启动当前实例-当我在Excel 64位中工作时,当另一个应用程序打开另一个Excel 32位时,我有时会出错。看看任务管理器。
-
工作表是否已损坏?这是最后的手段,但你是否尝试过打开另一个新工作簿,并将数据和代码复制到其中,然后重新保存。我已经用它来克服不稳定的行为,尤其是在网络上有大床单的情况下。
只是想帮你找出这种令人恼火的行为。
这不一定是答案,但也许它会让你看到另一件事
1) 我在Access中编码时也有类似的行为。在我的特定例子中,我有一个隐藏的窗体在后台运行,它链接到一个计时器。计时器触发的代码将检查数据库中的一些表。
最终的结果与您所描述的行为非常相似。当我写代码时,代码在行的中间被切断。代码变红。等等。
你有后台运行的计时器吗?
2) 我没有遇到TM1的问题,但我们的EIKON插件会导致各种奇怪的行为,比如不返回shell命令。在这种情况下,唯一有帮助的是完全删除外接程序。不仅仅是停用它。删除它!