Question

我有一个数据表，我想根据策略编号的开头进行过滤，然后我想将所有BFL策略都移到PFL策略之后。第1行包含所有标题。我的保单号以PFL或BFL开头。

我之所以不能直接对ZA进行排序是因为原始数据从BFL001到BFL999，然后是PFL001到PFL999，所以对ZA进行排序将首先得到PFL999，但是我想将PFL001之后的所有内容从BFL001移到BFL999，就像简单一样剪切和粘贴。我的范围每月变化，因此我使用001到999来显示原始数据的显示方式。

运行我当前的VBA模块后，它从行1000开始，从BFL001到PFL999，这不是我想要的。我需要从PFL001到PFL999，然后从BFL001到BFL999，并且两者之间没有空行。

我不确定是否可以使用部分搜索或使用类似文本的内容查找以BFL开头的策略，然后剪切并粘贴到最后一行+1。不确定哪种方法更快。

Sub test()
    Dim LR1 As Long
    LR1 = Range("A" & Rows.Count).End(xlUp).Row

    With Worksheets("Combined")
        With .Range("A2:AU" & LR1)
             .AutoFilter Field:=1, Criteria1:="BFL" & "*"
             .Cut Range("A" & LR1 + 1)
        End With
             .AutoFilterMode = False
    End With
End Sub

Answer 1

VBA的一个巧妙技巧是，在您想使用.SpecialCells的情况下，您可以使用xlCellTypeVisible来引用共享属性的某些单元格，但是还有许多其他可以使用的单元格。 / p>

这里的技巧是手动进行切割。您无法剪切彼此相邻的单元格，但可以复制并粘贴它们。因此，想法是将BFL单元格粘贴在PFL单元下方，然后清空原始单元格并清理空白区域。应用自动过滤器后，您可以告诉excel只查看您之前指定的相同范围内的可见单元格，因此您不会得到任何多余的信息。这很重要，因为当您清除所有可见的单元格时，您不想意外地清除刚粘贴在下面的单元格。

清理空白单元格时，从下至上很重要，因为否则您可能会遇到索引问题。您还会注意到，我使用.entirerow来删除整个行，而不仅仅是第一列。

要显示所有数据，只需转到Worksheet.showalldata，但，您需要检查甚至没有自动过滤器应用于工作表。偶尔执行清除单元格之类的操作时，它会关闭自动过滤器，因此最好检查它是否仍然存在，以便您的宏不会对您造成错误。

最后一件小事，尽管您没看错，但没有必要将字符串与通配符*串联在一起，只需将它们包含在同一字符串中即可。例如。 "BFL*"与"BFL" & "*"仅节省了键入时间。

Sub test()
    Dim LR1 As Long
    Dim BFLRange As Range
    LR1 = Range("A" & Rows.Count).End(xlUp).Row
    Dim i As Long

    With Worksheets("Combined")
        With .Range("A2:AU" & LR1)
             .AutoFilter Field:=1, Criteria1:="BFL" & "*"

             Set BFLRange = .SpecialCells(xlCellTypeVisible)
             BFLRange.Copy Destination:=Worksheets("Combined").Range("A" & LR1 + 1)
        End With
        BFLRange.Clear

        For i = LR1 To 2 Step -1
            If IsEmpty(.Cells(i, 1)) Then
                .Cells(i, 1).EntireRow.Delete shift:=xlUp
            End If
        Next i
        If .AutoFilterMode Then
            .ShowAllData
        End If
    End With
End Sub

此代码段遵循@SJR的建议，其中删除了包含BFL的整个使用区域。我禁用警报的原因是因为仅弹出一个小文本框，询问您是否确定要删除工作表行。通过关闭它，不需要任何用户输入。值得一提的是，如果您要处理大量数据，则一次删除单元格将大大加快宏的速度。再次感谢@SJR。

Sub test()
    Dim LR1 As Long
    Dim BFLRange As Range
    LR1 = Range("A" & Rows.Count).End(xlUp).Row
    Dim i As Long

    With Worksheets("Combined")
        With .Range("A2:AU" & LR1)
             .AutoFilter Field:=1, Criteria1:="BFL" & "*"

             Set BFLRange = .SpecialCells(xlCellTypeVisible)
             BFLRange.Copy Destination:=Worksheets("Combined").Range("A" & LR1 + 1)
        End With

        Application.DisplayAlerts = False
        BFLRange.Delete
        Application.DisplayAlerts = True

'        For i = LR1 To 2 Step -1
'            If IsEmpty(.Cells(i, 1)) Then
'                .Cells(i, 1).EntireRow.Delete shift:=xlUp
'            End If
'        Next i
        If .AutoFilterMode Then
            .ShowAllData
        End If
    End With
End Sub

剪切和粘贴范围在过滤时不起作用

1 个答案: