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手動）