0

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

我有以下代码不能让我平静地工作——虽然我没有 VBA 能力，但我已经设法在大约一周左右的时间里把它放在一起。启动宏后，大多数时候我根本不能触摸 excel 约 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 - 因为我的队友将使用这个，有没有办法让这个宏在法语 PC 上工作？因为在早期版本中不是（在寻找“Sheet1”时制作“Feuil1”并将公式用英文而不是翻译它们）。据我了解，宏会自动转换为通用编程语言，以便在打开它们的任何地方读取。

4

2 回答 2

3

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

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

例如：（我仅使用“FALSE”作为示例 - 以下公式也适用于“=SUM(A1)”等公式，当然，如果您真的想设置布尔值，请不要使用字符串“真的”！）

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）

于 2013-07-28T10:57:46.653 回答
3

Cor_Blimey 在上面为您提供了一些重要信息。我会补充这一点。

Select如果您学会避免使用and方法，您的代码可能会得到改进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

于 2013-07-28T17:02:03.127 回答