VBA代码崩溃Excel如果提早关闭

Question

再次您好，感谢您的时间！

我有下面的代码，不会让我在和平的工作 - 虽然我没有VBA的力量，我设法在大约一个星期左右把它放在一起。 启动宏后，大部分时间我摸不得擅长所有〜2分钟，但我有多次为它关闭本身...

Sub Filter() 
' 
' substitute Macro 

Application.ScreenUpdating = False 
Selection.Copy 
ActiveWindow.ActivateNext 
Sheets.Add After:=Sheets(Sheets.Count) 
ActiveSheet.Name = "buffer" 

    Dim wsS As Worksheet, wsN As Worksheet, i As Integer, j As Integer, k As Integer, l As Integer 
    Set wsS = Sheets("buffer") 
    Set wsN = Sheets("non_confid") 

    colA = "A" 
    colB = "B" 
    colC = "C" 
    colE = "E" 
    i = 2 

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Selection.Replace What:=" ", Replacement:="," 
Range("A1").Copy 
Range("z1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Columns("A:y").Select 
Range("F25").Activate 
Application.CutCopyMode = False 
Selection.Delete Shift:=xlToLeft 

    Range("B1").FormulaR1C1 = "=SUBSTITUTE(RC[-1],CHAR(13),"";"")" 
    Range("C1").FormulaR1C1 = "=SUBSTITUTE(RC[-1],CHAR(10),"";"")" 
    Range("D1").FormulaR1C1 = "=substitute(rc[-1],""/"","";"")" 
    Range("e1").FormulaR1C1 = "=substitute(rc[-1],""consultant"","";"")" 
    Range("f1").FormulaR1C1 = "=substitute(rc[-1],""dessinateur"","";"")" 
    Range("g1").FormulaR1C1 = "=substitute(rc[-1],""grp"","";"")" 
    Range("h1").FormulaR1C1 = "=substitute(rc[-1],""projet"","";"")" 
    Range("i1").FormulaR1C1 = "=substitute(rc[-1],""Inscrire dans ce pavé les projets ou familles concernés"","";"")" 
    Range("j1").FormulaR1C1 = "=substitute(rc[-1],""Inscrire dans ce pavé les profils demandés"","";"")" 
    Range("k1").FormulaR1C1 = "=substitute(rc[-1],""Droits en consultation"","";"")" 
    Range("l1").FormulaR1C1 = "=substitute(rc[-1],""Droits en création"","";"")" 
    Range("m1").FormulaR1C1 = "=substitute(rc[-1],"":"","";"")" 
    Range("n1").FormulaR1C1 = "=substitute(rc[-1],""("","";"")" 
    Range("o1").FormulaR1C1 = "=substitute(rc[-1],"")"","";"")" 
    Range("p1").FormulaR1C1 = "=substitute(rc[-1],""profil"","";"")" 
    Range("q1").FormulaR1C1 = "=substitute(rc[-1],""non,confid"","";"")" 
    Range("r1").FormulaR1C1 = "=substitute(rc[-1],"" "","";"")" 

Range("r1").Copy 
Range("s2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Rows("1:1").Select 
Application.CutCopyMode = False 
Selection.Delete Shift:=xlUp 
Columns("A:r").Select 
Selection.Delete Shift:=xlToLeft 
Range("A1").Select 
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, Comma:=True, Space:=False, OtherChar:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1)) 
Range(Selection, Selection.End(xlToRight)).Copy 
Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 
Rows("1:1").Select 
Application.CutCopyMode = False 
Selection.Delete Shift:=xlUp 

Columns("A:A").EntireColumn.AutoFit 
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Range("a1").FormulaR1C1 = "Sorted" 
Range("a1").Select 
ActiveSheet.Range("$A$1:$A$300").RemoveDuplicates Columns:=1, Header:=xlNo 
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$a$500"), , xlYes).Name = "Table1" 
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>" 

Range("B2").Select 
ActiveCell.FormulaR1C1 = _ 
    "=IFERROR(IF(ISNA(MATCH([@Sorted],NPDM[Contexte],0)),IF(FIND(""."",[@Sorted]),[@Sorted],""""),""""),"""")" 
Range("B1").FormulaR1C1 = "Formula" 
Range("Table1[Formula]").Select 
Selection.Copy 
Range("C2").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Columns("B:B").Select 
Application.CutCopyMode = False 
Selection.Delete Shift:=xlToLeft 
Range("B1").FormulaR1C1 = "Dot" 

Range("Table1[Dot]").Select 
Selection.TextToColumns Destination:=Range("Table1[[#Headers],[Dot]]"), _ 
    DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _ 
    :=True, Tab:=True, Semicolon:=True, Comma:=True, Space:=False, Other _ 
    :=True, OtherChar:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), _ 
    TrailingMinusNumbers:=True 
Range("C1").FormulaR1C1 = "nDot" 
Range("B1").FormulaR1C1 = "Dot" 

Range("Table1[Dot]").Select 
Selection.Copy 
Range("A250").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=True, Transpose:=False 
Range("Table1[nDot]").Select 
Selection.Copy 
Range("A500").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=True, Transpose:=False 
Range("B:C").EntireColumn.Delete 

    For j = 2 To 300 
     If Not IsEmpty(wsS.Range(colA & j).Value) Then 
      wsS.Range(colC & i - 1).Value = wsS.Range(colA & j).Value 
      i = i + 1 
     End If 
    Next 

Range("A:B").EntireColumn.Delete 

    For k = 1 To 300 
      If Not IsEmpty(wsS.Range(colA & k).Value) Then 
       wsN.Range(colE & i).Value = wsS.Range(colA & k).Value 
       i = i + 1 
      End If 
    Next 

Sheets("non_confid").Select 
Columns("A:G").EntireColumn.AutoFit 
Range("e1").Select 
ActiveSheet.ListObjects("Status").Range.AutoFilter Field:=4, Criteria1:="<>" 
Range("E2").Select 
ActiveWorkbook.Worksheets("non_confid").ListObjects("Status").Sort.SortFields. _ 
    Clear 
ActiveWorkbook.Worksheets("non_confid").ListObjects("Status").Sort.SortFields. _ 
    Add Key:=Range("Status[ce ?]"), SortOn:=xlSortOnValues, Order:= _ 
    xlAscending, DataOption:=xlSortNormal 

    With ActiveWorkbook.Worksheets("non_confid").ListObjects("Status").Sort 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

Range("A1").Select 
Application.DisplayAlerts = False 
Sheets("buffer").Select 
ActiveWindow.SelectedSheets.Delete 
Application.DisplayAlerts = True 
ActiveWorkbook.Saved = True 
Application.ScreenUpdating = True 
End Sub 

PS - 因为我的队友会与此合作，是否有一种方法可以让这个宏在法语版的个人电脑上工作？因为在较早的版本中没有（在查找“Sheet1”时将“Feuil1”制作成英文，而不是将它们翻译成英文）。据我所知，宏自动转换为通用编程语言，无论打开哪个位置都可以读取。

Answer 1

Cor_Blimey给了你上面的一些很好的信息。我会补充到这一点。

如果您学习避免Select和Activate方法（这会强制您依赖体积更大，代码繁琐，执行时间更长）的代码，则可能可以改进您的代码。它也使代码不易读取，因为它不是面向对象的。

此外，很多人不必要地依赖Copy & Paste方法，但这通常也可以避免。

下面是这样一个例子，其中复制的范围内，然后粘贴值到另一个范围：

Range("A1").Copy 
Range("z1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

这可以简化，如：

Range("Z1").Value = Range("A1").Value 

这里是不必要Select一个例子方法：

Rows("1:1").Select 
Application.CutCopyMode = False 
Selection.Delete Shift:=xlUp 

这三行代码可以用一个语句：

Rows("1:1").EntireRow.Delete 

而另一（有这样的几个例子）：

Range("B2").Select 
ActiveCell.FormulaR1C1 = _ 
"=IFERROR(IF(ISNA(MATCH([@Sorted],NPDM[Contexte],0)),IF(FIND(""."",[@Sorted]),[@Sorted],""""),""""),"""")" 

在上述中，首先选择/激活的细胞，然后在ActiveCell操作。这是不必要的，您可以直接在对象上直接操作：

Range("B2").FormulaR1C1 = "=IFERROR(IF(ISNA(MATCH([@Sorted],NPDM[Contexte],0)),IF(FIND(""."",[@Sorted]),[@Sorted],""""),""""),"""")" 

这些都是一些有用的编码实践。否则，@ Cor_Blimey上面的答案非常好。 Application.ScreenUpdating应该加快执行时间，并且如果可能的话，设置Application.Calculation = xlManual也将有所帮助。但是，.Calculation方法在这种情况下可能不适用，因为在将.Values从一个范围移动到另一个范围时，您可能正在依靠临时计算。

Answer 2

对于非英语语言，您可以使用.FormulaLocal或.FormulaR1C1Local。开发人员参考说：“返回或设置对象的公式，使用用户语言中的R1C1风格表示法。读/写变式”。

然而，我强烈建议不要使用上述，因为这将意味着，如果宏在不同的语言版本上运行，它不会工作。相反，更好的做法是将英语与.Formula和.FormulaR1C1结合使用。在法文版本中，这仍然会以法文形式打开，因为Excel会自动以相关语言显示公式文本。

例如：（我只使用“FALSE”作为示例 - 下面的公式也适用于“= SUM（A1）”，当然，如果您确实想设置布尔值，请不要“T使用字符串‘TRUE’）

ActiveCell.Formula = "FALSE" 

好 - ！语言环境无关 - 这将是一个假布尔值显示为FALSE英语和法文显示为伪造品，但在这两种情况下，一个布尔值

ActiveCell.FormulaLocal = "FAUX" 

'坏 - 区域依赖！ - 这将是一个字符串“FAUX”如果要是在法文版

ActiveCell.Formula = "FAUX" 

“语言环境无关，但可能不是你想要的运行宏上的英语版本， 而是一个布尔值false运行 - 这将是所有语言的字符串“FAUX”

您不应该通过诸如“Feuil1”之类的方式硬编码引用表。这只是一个字符串名称，Excel不会适应用户的区域设置。相反，当您添加新工作表时，请立即将其分配给工作表变量，然后使用它。

例如：

'Bad: it might work if the workbook is made on a French version but it won't on English and vice versa 
Worksheets("Feuil1").Activate 
Worksheets("Sheet1").Activate 'also bad 

'Better: 
Worksheets(1).Activate 
'or 
With Worksheets.Add 
.Name = "Results" 
.Activate 
End With 
'or (for use outside a With block) 
Set resultsWs = Worksheets.Add 

至于其余的 - 恐怕我不知道你的问题是什么。它有时可能会崩溃，因为您正在使用大量的剪切/复制 - 如果它是一个非常大的工作表或者有很多重新计算每个剪切/插入的公式，这将需要很长时间。除非需要中间计算，否则在开始时禁用计算和屏幕更新，并且只能在最后重新启用（使用Application.ScreenUpdating = False和Application。计算= XL手动）