问使用VBA在包含特定字符的范围内复制单元格。

EN

If Range("A" & i) Like "*[*^]*[*^]*" Then

Option Explicit
Sub MatchCharacters()
    Dim src As Variant, tmp As Variant
    Dim Character As String, Character2 As String

    Character = "*"
    Character2 = "^"
    ' Replace with your sheetname
    With Sheet1
        src = Application.Transpose(Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)))
        tmp = Filter(Filter(src, Character), Character2)

        .Range(.Cells(2, 3), .Cells(.Cells(1, 3).End(xlDown).Row, 3)).ClearContents
        If UBound(tmp) > -1 Then
            With .Cells(2, 3)
                Range(.Offset(0, 0), .Offset(UBound(tmp), 0)).Value2 = Application.Transpose(tmp)
            End With
        End If
    End With
End Sub

Public Function MatchCharacters(arr As Variant, ParamArray Characters() As Variant) As Variant
    Dim i As Long
    For i = LBound(Characters) To UBound(Characters)
        arr = Filter(arr, Characters(i))
    Next i
    MatchCharacters = arr
End Function

Sub test()
    Dim tmp As Variant

    With Sheet1
        tmp = Application.Transpose(Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)))

        tmp = MatchCharacters(tmp, "*", "^")

        If UBound(tmp) > -1 Then
            With .Cells(2, 3)
                Range(.Offset(0, 0), .Offset(UBound(tmp), 0)).Value2 = Application.Transpose(tmp)
            End With
        End If
    End With
End Sub

Sub RunCopyFilter()
    Dim CriteriaCorner As Integer
    CriteriaCorner = Application.WorksheetFunction.Max( _
    Range("B11").End(xlUp).Row, _
    Range("C11").End(xlUp).Row, _
    Range("D11").End(xlUp).Row)
    [A4:A10].AdvancedFilter xlFilterCopy, Range("B4:D" & CriteriaCorner), [E4:E10], True
End Sub

Function InStrTolerant(InputString As String, MatchString As String, Optional CaseInsensitiveChoice = False, Optional Tolerance As Integer = 0) As Integer
'Similar to InStr, but allows for a tolerance in matching


Dim ApxStr As String 'Approximate String to Construct
Dim j As Integer 'Match string index
j = 1
Dim Strikes As Integer
Dim FoundIdx As Integer

For i = 1 To Len(InputString)

    'We can exit early if a match has been found
    If StringsMatch(ApxStr, MatchString, CaseInsensitiveChoice) Then
        InStrTolerant = FoundIdx
        Exit Function
    End If

    If StringsMatch(Mid(InputString, i, 1), Mid(MatchString, j, 1), CaseInsensitiveChoice) Then
        'This character matches, continue constructing
        ApxStr = ApxStr + Mid(InputString, i, 1)
        j = j + 1
        FoundIdx = i
    Else
        'This character doesn't match
        'Substitute with matching value and continue constructing
        ApxStr = ApxStr + Mid(MatchString, j, 1)
        j = j + 1
        'Since it didn't match, take a strike
        Strikes = Strikes + 1
    End If

    If Strikes > Tolerance Then
        'Strikes exceed tolerance, reset contruction
        ApxStr = ""
        j = 1
        Strikes = 0
        i = i - Tolerance
    End If
Next

If StringsMatch(ApxStr, MatchString, CaseInsensitiveChoice) Then
    InStrTolerant = FoundIdx
Else
    InStrTolerant = 0
End If

End Function