Question

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

对我来说很好，但对我的同事来说却很好。绿色的代码可以正常工作，并且可以正确地移动行，而红色的代码则无法工作。它会找到行并将其删除，但不会将其移到另一张纸上。

Screenshot of Code

实际代码：

 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都很重要，而不仅仅是应用一个。代码已更改为执行此操作。

宏在我的Excel上有效，但其他人无法使用

3 个答案: