将已过滤列表中的多个值添加到字符串，然后将其用于创建电子邮件列表

Question

我正在尝试使用VBA创建一个字符串，该字符串包含在以分号分隔的单元格B8到B1129中过滤后的所有可见值。有人可以帮我吗？

Answer 1

如果已应用过滤器，则可以使用以下代码（结果存储在单元格C2中）：

 Sub test()
    Dim rng As Range
    Dim res As String
    Dim c As Range

    On Error Resume Next
    'change "Sheet1" to your cheet name'
    With ThisWorkbook.Sheets("Sheet1")
        Set rng = .Range("B8:B1129").Rows.SpecialCells(xlCellTypeVisible)

        For Each c In rng
            If Not ISEmpty(c) Then res = res & c.Value & ", "
        Next
        res = Left(res, Len(res) - 2)

        .Range("C2") = res
    End With

End Sub

或者您可以直接从VBA申请自动过滤器：

 Sub test()
    Dim rng As Range
    Dim res As String
    Dim c As Range

    On Error Resume Next

    'change "Sheet1" to your cheet name'
    With ThisWorkbook.Sheets("Sheet1")
        .AutoFilterMode = False
        .Range("B1").AutoFilter Field:=1, Criteria1:="=*searchText*"

        Set rng = .Range("B8:B1129").Rows.SpecialCells(xlCellTypeVisible)

        For Each c In rng
            If Not ISEmpty(c) Then res = res & c.Value & ", "
        Next
        res = Left(res, Len(res) - 2)

        .Range("C2") = res
    End With

End Sub