宏适用于我的 Excel，但不适用于其他人

Question

我在下面创建了宏。它应该根据它找到一个特定的行，复制它，删除它并将其粘贴到同一工作簿中的单独工作表上。

它对我来说非常好，但对我的同事不适用。绿色代码工作并正确移动行，红色代码不起作用。它会找到行并删除它们，但不会将它们移动到另一张纸上。

实际代码：

 With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*L5P*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Powerstroke 6.0L*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Powerstroke 7.3L*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Nissan Titan*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

此人与我拥有相同版本的 Excel，并且也像我一样运行 Windows 10。

想法？

Answer 1

这是一些多余的代码。获取这些块中的任何一个并将其提取到自己的参数化过程中：

Private Sub CopyAndFilter(ByVal fromSheet As Worksheet, ByVal toSheet As Workshet, ByVal filter As String)
    With fromSheet
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:Q1").AutoFilter 8, filter
      With .AutoFilter.Range.Offset(1)
         .Copy toSheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
         .EntireRow.Delete
      End With
      .AutoFilterMode = False
    End With
End Sub

现在你的调用代码是：

Dim source As Worksheet
Set source = ActiveSheet

Dim destination As Worksheet
Set destination = ThisWorkbook.Worksheets("L5p Orders")

CopyAndFilter source, destination, "*L5P*"
CopyAndFilter source, destination, "*Powerstroke 6.0L*"
CopyAndFilter source, destination, "*Powerstroke 7.3L*"
CopyAndFilter source, destination, "*Nissan Titan*"

这样，您只需取消引用 source 和 destination 工作表一次，并且大大减少了重复，从而确保所有块都以相同的方式工作。

Answer 2

不是答案，但您的代码将更易于管理：

For Each t In Array("*L5P*", "*Powerstroke 6.0L*", "*Powerstroke 7.3L*", "*Nissan Titan*")

    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        .Range("A1:Q1").AutoFilter 8, t
        With .AutoFilter.Range.Offset(1)
           .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
           .EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With

Next t

...您可以确定每个术语都得到完全相同的处理...

Answer 3

我怀疑问题在于，在您同事的机器上，正在应用的过滤器在复制数据之前没有完成。在过滤器应用程序之后添加DoEvents 应该会导致一切停止并等待过滤器完成。

当我在那里时，我也稍微缩短了过程：

Sub test_this()

    Dim fltr As Variant

    With ActiveSheet

        For Each fltr In Array("*L5P*", "*Powerstroke 6.0L*", "*Powerstroke 7.3L*", "*Nissan Titan*")

          If .AutoFilterMode Then .AutoFilterMode = False
          DoEvents 'make sure removing filter finishes
          .Range("A1:Q1").AutoFilter 8, fltr
          DoEvents 'make sure applying filter finishes
          With .AutoFilter.Range.Offset(1)
             .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
             .EntireRow.Delete
          End With
          .AutoFilterMode = False
          DoEvents 'make sure removing filter finishes
        Next

    End With

End Sub

编辑：对不起，我重新考虑了。我认为在每次过滤器更改后对 DoEvents 很重要，而不仅仅是在应用过滤器时。为此更改了代码。