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

前段時間我寫了一個函數，它有點小e靈活，可以根據需要修剪空間等。也許這會幫助其他有類似問題的人。

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