vba - 根据单元格中的非精确值使用 VBA 对列表进行排序

Question

我是 VBA 的新手，希望能得到一些关于排序和排序的指导。

我有一个包含大约 200 行和 5 列的信息表。在 B 列中有“附加信息”，我希望确定哪些行的文本部分包含以下任何单词:“培训”、“管理员”、“常规”和“额外信息”，并将它们组合在一起.

所以一个例子是:
个人管理员，
工作管理员，
重量训练，
DD额外信息，
EAS培训，
一般写作。

所以我需要能够仅根据每个单元格的部分值对整行进行排序和排序。

希望这是有道理的 - 我非常感谢任何指导!

我过去曾使用此自定义列表来查找和排序确切的短语:

Dim nCustomSort As Variant
Dim xx As Long

nCustomSort = Array("Training", "Admin", "General", "Extra Info")

Application.AddCustomList ListArray:=nCustomSort

With Worksheets("Sheet1")
.Sort.SortFields.Clear
xx = .Cells(Rows.Count, "B").End(xlUp).Row
  With .Range("A1:Z1000" & xx)
  .Cells.Sort Key1:=.Columns(2), Order1:=xlAscending, _
              Orientation:=xlTopToBottom, Header:=xlYes, MatchCase:=False, _
              OrderCustom:=Application.CustomListCount + 1

  End With
  .Sort.SortFields.Clear
End With

Answer 1

这是一个没有帮助列的提案:

Option Explicit

Sub sort()
    Dim nCustomSort As Variant, elem As Variant
    Dim LastCell As Range

    nCustomSort = Array("=*Training*", "=*Admin*", "=*General*", "=*Extra Info*") '<--| the order of appearance in this array determines the order of sorting
    Application.DisplayAlerts = False
    With Worksheets("Sheet1")
        With .Range("A1:Z" & .Cells(Rows.Count, "B").End(xlUp).Row)
            Set LastCell = .Cells(.Rows.Count, 1).Offset(1)
            For Each elem In nCustomSort
                .AutoFilter field:=2, Criteria1:=elem
                If Application.WorksheetFunction.Subtotal(103, .Offset(, 1).Resize(, 1)) > 1 Then
                    With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
                        .Copy LastCell
                        Set LastCell = .Parent.Cells(.Parent.Rows.Count, 2).End(xlUp).Offset(1, -1)
                        .Delete
                    End With
                End If
            Next elem
        End With
        .AutoFilterMode = False
    End With
    Application.DisplayAlerts = True
End Sub

缺点是复制和删除是一项耗时的操作，因此如果您有许多 k 行，则可能需要很长时间