早期closuresExcel的VBA代码崩溃
你好，再次感谢您的时间！
我有下面的代码，不会让我在和平的工作 – 虽然我没有VBA的权力，我已经设法在大约一个星期左右的时间合并起来。 发射macros后，大多数时候我绝对不会碰到2分钟的优秀，但是我确实有它自己closures的场合。
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 – 因为我的队友们正在处理这个问题，有没有办法让这个macros在法语的个人电脑上工作？ 因为在较早的版本中没有（在查找“Sheet1”时使“Feuil1”变成英文而不是翻译它们）。 据我了解，macros自动转换为通用编程语言，无论打开哪里都可以读取。
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
这三行代码可以replace为一个语句：
Rows("1:1").EntireRow.Delete
另一个（有这样几个例子）：
Range("B2").Select ActiveCell.FormulaR1C1 = _ "=IFERROR(IF(ISNA(MATCH([@Sorted],NPDM[Contexte],0)),IF(FIND(""."",[@Sorted]),[@Sorted],""""),""""),"""")"
在上面，你首先select/激活一个单元格，然后你在ActiveCell上进行操作。 这是不必要的，你可以直接在对象上直接操作：
Range("B2").FormulaR1C1 = "=IFERROR(IF(ISNA(MATCH([@Sorted],NPDM[Contexte],0)),IF(FIND(""."",[@Sorted]),[@Sorted],""""),""""),"""")"
这是一些有用的编码实践。 否则，@ Cor_Blimey上面的答案是非常好的。 Application.ScreenUpdating应该加快执行时间，并且如果可能的话，设置Application.Calculation = xlManual也将有所帮助。 但是，在这种情况下， .Calculation方法可能不是一种select，因为在移动时，您可能依赖于临时计算。从一个范围到另一个范围的值。
对于非英语语言，您可以使用.FormulaLocal或.FormulaR1C1Local。 开发人员参考说：“返回或设置对象的公式，使用R1C1风格的符号在用户的语言。读/写变式”。
不过， 我强烈build议不要使用上述内容 ，因为如果macros运行在不同的语言版本上，这将意味着它将不起作用。 相反，更好的做法是将英语与.Formula和.FormulaR1C1结合使用。 这将仍然在法文版本中以法文打开，因为Excel会自动显示相关语言的公式文本。
例如：（我只使用“FALSE”作为例子 – 对于公式也是如此，如“= SUM（A1）”，当然，如果你真的想设置一个布尔值，那么请不要使用string“真正”！）
ActiveCell.Formula = "FALSE"
OK – 区域独立 – 这将是一个FALSE布尔值，在英语中显示为FALSE，在法语中显示为FAUX，但在这两种情况下，它都是一个布尔值
ActiveCell.FormulaLocal = "FAUX"
'坏 – 区域依赖！ – 如果macros运行在英文版本上，这将是一个string“FAUX”，但是如果运行在法文版本上，则为布尔FALSE
ActiveCell.Formula = "FAUX"
'区域独立，但可能不是你想要的 – 这将是所有语言中的string“FAUX”
您不应该通过像“Feuil1”这样的硬编码来引用表单。 这只是一个string名称，Excel不会适应用户的区域设置。 相反，当你添加一个新工作表时，立即将其分配给一个工作表variables，然后使用它。
例如：
'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.Calculation = XLManual）