excel - 基于 VBA 中字符串列中的字符应用过滤器

Question

所以我试图在应用多个过滤器后从列中复制唯一值。对于其中一个过滤器，我无法按确切的字符串进行过滤，因为该列是这样的:

我想要从右数第 8 个位置有“U”的值，并想忽略在同一个位置有“O”的值。

例如，在图像中:“S20-0260-TA-002_W06_05C_AMBRH_U-404728”应该存在，但“S20-0260-TA-001_W06_30C_75RH_O-404713”不应该存在。

我知道如何通过 RIGHT 函数从右侧检查字符，但我正在努力将它应用到带有 if 条件的过滤器中。到目前为止，这是我与其他过滤器的相关代码:

Dim uniquesArray As Variant
    Dim uniqueCond As Variant
    
    Dim lastCondRow As Long
    Dim lastRow As Long
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("New Data")
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Set DR = ThisWorkbook.Sheets("Test")
    
    With ThisWorkbook.Sheets("Test")
    
    'Find unique Condition
    Worksheets("New Data").Range("$B$1:$X$9999").AutoFilter Field:=10, Criteria1:= _
        "Assay by HPLC"
    Worksheets("New Data").Range("$B$1:$X$9999").AutoFilter Field:=15, Criteria1:= _
        "(Average)"
    
    ws.Range("I1:I9999").SpecialCells(xlCellTypeVisible).Copy
    .Cells(1, 27).PasteSpecial

        .Columns("AA:AA").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("AB1"), Unique:=True
        lastCondRow = .Cells(.Rows.Count, "AB").End(xlUp).Row
        uniqueCond = .Range("AB2:AB" & lastCondRow)
        .Columns("AB").ClearContents
        .Columns("AA").ClearContents
    End With

我想在查找独特评论下的 2 个自动过滤器下方应用此过滤器。列号是F，求助

Answer 1

备选方案

提供此替代方案，主要是为了演示如何应用多个过滤器，以及一种使用通配符应用条件来查找特定字符的确切位置的方法。这使用 3 步方法:

• 应用所有过滤器

• 复制数据

• 删除重复项——仅保留唯一值

所有操作都在“新数据”表上进行，您可以根据需要更改此表和引用的各个列。仅供演示之用。

Option Explicit
Sub testCopyUnique()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("New Data")
Application.ScreenUpdating = False

'Apply all filters and copy the visible cells
With ws.Cells(1, 2).CurrentRegion
    .AutoFilter 10, "Assay by HPLC"
    .AutoFilter 15, "(Average)"
    .AutoFilter 5, "*U???????"  '<~~ ”*” = any number of characters, “?” = one character
    ws.Range("I:I").SpecialCells(xlCellTypeVisible).Copy ws.Range("AA1")
    .AutoFilter
End With

'Remove the duplicates - leaving unique comments only
ws.Range("AA1:AA" & ws.Range("AA" & Rows.Count).End(xlUp).Row).RemoveDuplicates _
Columns:=1, Header:=xlYes

Application.ScreenUpdating = True
End Sub