Question

我想知道在UDF中创建VBA的最有效方法是将工作表中的范围与其他字符（例如逗号）连接起来。

我尝试了一些变体，但始终遇到一个问题，即如何自动从工作表中选择的范围调整数组大小。

波纹管代码有效，但是我相信必须有一种更有效的方法来实现。

你们能帮我吗？

谢谢。

Function conc(data As Range) As String
Dim hola() As Variant
t = data.Rows.Count
ReDim hola(1 To t)

a = 1
For Each i In data.Value
hola(a) = i & ","
a = a + 1
Next i

conc = Join(hola)
Erase hola
End Function

Answer 1

用于在一列多行中连接许多字符串（这是您的原始文件设计的目的）：

Function vconc(data As Range) As String

    vconc = Join(Application.Transpose(data), Chr(44))

End Function

要在一行中连接多列字符串：

Function hconc(data As Range) As String

    hconc = Join(Application.Transpose(Application.Transpose(data)), Chr(44))

End Function

Answer 2

不知道效率更高。您可以使用

连接特定的列

Public Function conc(ByVal data As Range) As String
    conc = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(data.Value, 0, 1)), ",")
End Function

受索引和转置的限制。

不止一列：

 Public Function conc(ByVal data As Range) As String
  Dim i As Long
  For i = 1 To data.Columns.Count
    conc = conc & Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(data.Value, 0, i)), ",")
  Next i
End Function

Answer 3

我早些时候写的这个函数非常有效和全面...它处理1d或2d数组，并且您可以跳过空白并添加定界符（如果需要）。有关说明和有效示例，请参见http://dailydoseofexcel.com/archives/2014/11/14/string-concatenation-is-like-the-weather/，有关VBA JOIN函数与直接串联的效率优势的讨论，请参见http://excellerando.blogspot.com/2012/08/join-and-split-functions-for-2.html

Option Explicit

Public Function JoinText( _
                InputRange As Range, _
                Optional SkipBlanks As Boolean = False, _
                Optional Delimiter As String = ",", _
                Optional FieldDelimiter As String = ";", _
                Optional EndDelimiter As String = vbNull, _
                Optional Transpose As Boolean) As String

'Based on code from Nigel Heffernan at Excellerando.Blogspot.com
'http://excellerando.blogspot.co.nz/2012/08/join-and-split-functions-for-2.html

' Join up a 1 or 2-dimensional array into a string.

'   ####################
'   # Revision history #
'   ####################

'   Date (YYYYMMDD)     Revised by:         Changes:
'   20141114            Jeff Weir           Turned into worksheet function, added FinalDelimiter and Transpose options
'   20141115            Jeff Weir           Changed FinalDelimiter to EndDelimiter that accepts string, with default of ""
'   20150211            Jeff Weir           Changed names of arguments and changed default orientation to Column=>Row



Dim InputArray As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngNext As Long
Dim i_lBound As Long
Dim i_uBound As Long
Dim j_lBound As Long
Dim j_uBound As Long
Dim arrTemp1() As String
Dim arrTemp2() As String


    If InputRange.Rows.Count = 1 Then
        If InputRange.Columns.Count = 1 Then
            GoTo errhandler 'InputRange is a single cell
        Else
            ' Selection is a Row Vector
            InputArray = Application.Transpose(InputRange)
        End If
    Else
        If InputRange.Columns.Count = 1 Then
            ' Selection is a Column Vector
            InputArray = InputRange
            Transpose = True
        Else:
            'Selection is 2D range. Transpose it, because our
            ' default input is data in rows
            If Not Transpose Then
                InputArray = Application.Transpose(InputRange)
            Else: InputArray = InputRange
            End If
        End If
    End If

    i_lBound = LBound(InputArray, 1)
    i_uBound = UBound(InputArray, 1)
    j_lBound = LBound(InputArray, 2)
    j_uBound = UBound(InputArray, 2)

    ReDim arrTemp1(j_lBound To j_uBound)
    ReDim arrTemp2(i_lBound To i_uBound)

    lngNext = 1
    For i = j_lBound To j_uBound
        On Error Resume Next
        If SkipBlanks Then
            If Transpose Then
                ReDim arrTemp2(i_lBound To WorksheetFunction.CountA(InputRange.Columns(i)))
            Else
                ReDim arrTemp2(i_lBound To WorksheetFunction.CountA(InputRange.Rows(i)))
            End If
        End If
        If Err.Number = 0 Then
            k = 1

            For j = i_lBound To i_uBound
                If SkipBlanks Then
                    If InputArray(j, i) <> "" Then
                        arrTemp2(k) = InputArray(j, i)
                        k = k + 1
                    End If
                Else
                    arrTemp2(j) = InputArray(j, i)
                End If
            Next j
            arrTemp1(lngNext) = Join(arrTemp2, Delimiter)
            lngNext = lngNext + 1
        Else:
            Err.Clear
        End If
    Next i

    If SkipBlanks Then ReDim Preserve arrTemp1(1 To lngNext - 1)
    If lngNext > 2 Then
        JoinText = Join(arrTemp1, FieldDelimiter)
    Else: JoinText = arrTemp1(1)
    End If
    If JoinText <> "" Then JoinText = JoinText & EndDelimiter


errhandler:
End Function

VBA excel高效的方法来连接数组UDF

3 个答案: