Question

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

我有以下代码，这些代码不会让我平静地工作 - 虽然我不是VBA的力量，但我已经设法将它们放在一起大约一个星期左右。在启动宏之后，大多数时候我一定不会在2分钟内触摸excel但我确实有自己关闭的场合......

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 - 因为我的队友将使用这个，有没有办法让这个宏在法语的PC上工作？因为在早期版本中没有（在寻找“Sheet1”时制作“Feuil1”并将公式放入英语而不是翻译它们）。据我所知，宏会自动转换为通用编程语言，无论它们在何处打开都可以读取。

Answer 1

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

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

例如:(我只使用“FALSE”作为示例 - 对于类似“= SUM（A1）”的公式，下面的情况也是如此，当然，如果你真的想设置一个布尔值，那么请不要t使用字符串“TRUE”！）

ActiveCell.Formula = "FALSE"

确定 - 独立于区域设置 - 这将是一个FALSE布尔值显示，在英语中为FALSE，显示在法语中为FAUX，但在两种情况下都是布尔值

ActiveCell.FormulaLocal = "FAUX"

'糟糕 - 依赖于语言环境！ - 如果宏在英文版上运行，这将是一个字符串“FAUX”，但如果在法语版本上运行，则为布尔值FALSE

ActiveCell.Formula = "FAUX"

'区域设置独立，但可能不是你想要的 - 这将是所有语言的字符串“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.Calculation = XLManual）

Answer 2

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从一个范围移动到另一个范围时，您可能依赖于临时计算。

如果提前关闭，VBA代码会崩溃Excel

2 个答案: