Excel VBA函数用于将非空单元格与用户定义的分隔符连接起来

Question

我找到了这段代码：

Function ConcatenateRange(ByVal cell_range As Range, _
                    Optional ByVal seperator As String) As String

Dim cell As Range
Dim newString As String
Dim cellArray As Variant
Dim i As Long, j As Long

cellArray = cell_range.Value

For i = 1 To UBound(cellArray, 1)
    For j = 1 To UBound(cellArray, 2)
        If Len(cellArray(i, j)) <> 0 Then
            newString = newString & (seperator & cellArray(i, j))
        End If
    Next
Next

If Len(newString) <> 0 Then
    newString = Right$(newString, (Len(newString) - Len(seperator)))
End If

ConcatenateRange = newString

End Function

它将一个范围组合成一个单元格（CONCATENATES单元格，并在每个部分之间添加一个空格）。我已经多次尝试编辑它以在每个项目之间添加“，”。问题是它引用了范围A1:A1000，我可能只使用10行或全部。我只是不希望它在我没有填充的每个单元格的组合结束时有额外的,,,,,,。

还想创建它的副本，它会添加一个;在每个项目的右侧。

如何编辑此选项以向左或向右添加这些部分，但仅用于填充的单元格。

感谢您的任何帮助。

Answer 1

你的宏已经有效了。 =ConcatenateRange(A1:A14,",")，其中A1到A4的数字为1-4，你会得到1,2,3,4。

Answer 2

如果要将单个列与空格连接，则可以将代码缩短为单行

为A1:A1000与,连接

x = Join(Filter(Application.Transpose(Application.Evaluate("=IF(Len(A1:A1000)>0,A1:a1000,""x"")")), "x", False), ",")

为A1:A1000与:连接

x = Join(Filter(Application.Transpose(Application.Evaluate("=IF(Len(A1:A1000)>0,A1:a1000,""x"")")), "x", False), ":")

Answer 3

我刚才写了一个函数，它有点灵活，如果需要可以修剪空格等等。也许这会帮助其他有类似问题的人。

Public Function ConcatDelim(ByRef rng As Range, _
    Optional ByVal sDelim As String, _
    Optional ByVal SkipBlanks As Boolean = True, _
    Optional ByVal DoTrim As Boolean = False) As String
' Purpose: Insert Delim between value of each cell in rng
' Inputs:
'   rng = Range to use for values in concatenated string
'   Delim = Delimiter to insert between each value
'   SkipBlanks = If True, must have non-empty value to insert Delim. False will
'               insert delimiters between each cell value, even if blank
'   DoTrim = If True, Trims spaces from cell value before inserting in string
' Returns:
'   String with cell values separated by Delim

    Dim nLoop As Long
    Dim sValue As String
    Dim sResult As String

    If DoTrim Then
        sResult = Trim(rng.Cells(1).Value)
    Else
        sResult = rng.Cells(1).Value
    End If
    For nLoop = 2 To rng.Cells.Count
        If DoTrim Then
            sValue = Trim(rng.Cells(nLoop).Value)
        Else
            sValue = rng.Cells(nLoop).Value
        End If
        If SkipBlanks = False _
            Or ((sResult <> "") And (sValue <> "") And (SkipBlanks)) Then
            sResult = sResult & sDelim
        End If
        sResult = sResult & sValue
    Next nLoop
    ConcatDelim = sResult

End Function