vbscript 自定义函数根据条件连接到或多个字符串。

Posted 2021-05-22

Public Function CONCATIF(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
Rem CONCATIF(Site!$G$1:$G$9000,H2,Site!$AE$1:$AE$9000,", ",TRUE)
Dim i As Long, j As Long
    
    With compareRange.Parent
        Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
    End With
    If compareRange Is Nothing Then Exit Function
    If stringsRange Is Nothing Then Set stringsRange = compareRange
    Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, stringsRange.Column - compareRange.Column)
    
    For i = 1 To compareRange.Rows.Count
        For j = 1 To compareRange.Columns.Count
            If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
                If InStr(CONCATIF, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
                    CONCATIF = CONCATIF & Delimiter & CStr(stringsRange.Cells(i, j))
                End If
            End If
        Next j
    Next i
CONCATIF = Mid(CONCATIF, Len(Delimiter) + 1)
End Function