文章/答案/技术大牛

发布

社区首页 >问答首页 >在我的TEXTJOIN UDF中对数组和范围的测试

问在我的TEXTJOIN UDF中对数组和范围的测试
EN

Code Review用户

提问于 2017-11-13 16:38:22

回答 3查看 1.2K关注 0票数 6

我在对堆栈溢出的许多回答中使用了以下代码，以模拟Office 365 Excel中提供的新的TEXTJOIN函数：

Function TEXTJOIN(delim As String, skipblank As Boolean, arr)
    Dim d As Long
    Dim c As Long
    Dim arr2()
    Dim t As Long, y As Long
    t = -1
    y = -1
    If TypeName(arr) = "Range" Then
        arr2 = arr.Value
    Else
        arr2 = arr
    End If
    On Error Resume Next
    t = UBound(arr2, 2)
    y = UBound(arr2, 1)
    On Error GoTo 0

    If t >= 0 And y >= 0 Then
        For c = LBound(arr2, 1) To UBound(arr2, 1)
            For d = LBound(arr2, 1) To UBound(arr2, 2)
                If arr2(c, d) <> "" Or Not skipblank Then
                    TEXTJOIN = TEXTJOIN & arr2(c, d) & delim
                End If
            Next d
        Next c
    Else
        For c = LBound(arr2) To UBound(arr2)
            If arr2(c) <> "" Or Not skipblank Then
                TEXTJOIN = TEXTJOIN & arr2(c) & delim
            End If
        Next c
    End If
    TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - Len(delim))
End Function

我已经成功地实现了它，因此它可以同时处理范围和数组，因此它可以处理：

=TEXTJOIN(",",TRUE,A1:B7)

以及

{=TEXTJOIN(",",TRUE,IF(A1:A7 = "x",B1:B7,""))}

问题是:这是检查数组和范围的最佳方法吗？有更好的方法吗？

如前所述，这两者都很好，但我不得不认为我是在以一种周全的方式来做。

vba

excel

回答 3

Code Review用户

回答已采纳

发布于 2017-11-13 18:15:35

好的，让我们首先消除橡胶鸭指出的简单的东西：

函数是隐式的Public，并且隐式返回Variant -应该是String。
所有参数都隐式传递ByRef (语义上应该是ByVal)。
参数arr是隐式Variant，
局部变量c、d、t、y、arr2都有可怕的、毫无意义的名称(arr，matey！..I喜欢称之为海盗符号;)
应该使用String-returning Left$函数而不是Variant-returning Left函数。
vbNullString可能应该比""空字符串文本更好。

在默认设置下，Rubber鸭子也会抱怨Dim t As Long, y As Long，因为在一条指令中有多个声明并不理想。

变量是在函数的顶部声明的，而不是尽可能接近它们的用法，这使得很难看到在哪里使用了什么。

类型检查不安全：

如果TypeName( arr ) = "Range“，则arr2 = arr.Value arr2 =arr结束

如果引用了Microsoft对象模型，您可以传递一个Word.Range对象，它将很高兴地接受它；如果我创建了自己的Range类并给它一个实例，情况也是一样的。使用TypeOf操作符执行编译时类型安全类型检查：

If TypeOf arr Is Excel.Range Then
    'definitely an Excel Range object
Else
    'could be anything
End If

注意，在Else分支中，arr实际上可以是任何东西-但是您假设它是一个数组。您可以使用IsArray函数来确保这一点，然后还可以使用相当丑陋的辅助函数在上限上进行断言，以确保您正在查看所期望的2D数组。

Else
    Debug.Assert IsArray(arr)
    Debug.Assert GetArrayDimSize(arr) = 2
    arr2 = arr
End If

使用已知/断言的数组维数，可以删除下面的On Error Resume Next语句.t可以改名为sourceColumns或colCount或其他什么，y也可以改名为sourceRows或rowCount或其他什么-- arr2也可以改名为sourceArray：

sourceColumns = UBound(sourceArray, 2)
sourceRows = UBound(sourceArray, 1)

使用这个命名方案，我想我应该将arr参数重命名为source。

如果t >= 0和y >= 0那么

啊，好的，这个条件利用了这样一个事实: VBA会抛出一个给定的1D数组的错误，留下t = 0。不太明显，让我们改进一下。

但是首先我们需要调整断言-我们并不是真的想要一个2D数组，我们只是想要任何最多二维的数组。所以..。除了这一点，我们就不要那么宽容了：

Dim dimensionCount As Long
If TypeOf(arr) Is Excel.Range Then
    sourceArray = source.Value
    dimensionCount = 2 'Range.Value is always a 2D array
Else
    Dim isValidArray As Boolean
    isValidArray = IsArray(source)
    If isValidArray Then dimensionCount = GetArrayDimSize(source)
    isValidArray = dimensionCount <> 0 And dimensionCount <= 2
    If Not isValidArray Then Err.Raise 5, "TEXTJOIN", "Expected: 1D or 2D array"
End If

现在，If语句可以更加明确地说明发生了什么以及原因：

If dimensionCount = 2 Then
    'handle 2D array
Else
    Debug.Assert dimensionCount = 1
    'handle 1D array
End If

因此，c迭代维度1/行，d迭代维度2/列。

现在所有这些连接都是固有的缓慢。我意识到这只是“一个工作表函数”，您希望将它作为一个单一的、简单的、内聚的和集中的小代码来共享.但是，考虑到数千次迭代，VBA的字符串处理将开始成为该函数的性能瓶颈。

在这个站点上有一个闪电快的StringBuilder类，您可以使用它来解决这个问题。

一个额外的好处是，使用StringBuilder使函数只为其返回值赋值一次--与您现在拥有的相反，后者将返回值-标识符视为局部变量(从技术上讲，...I只是不喜欢这样做)。

不确定为什么d / column循环在这里不一致：

对于d= LBound(arr2，1)到UBound(arr2，2)

你在迭代第二维，LBound也应该离开第二维(是的，它应该和第一维完全一样)。此外，这两个维度的上界已经知道并存储在局部变量中：

For currentRow = LBound(sourceArray, 1) To sourceRows
    For currentColumn = LBound(sourceArray, 2) To sourceColumns

这段代码会抛出一个错误(通过设计？)如果数组包含Error值：

如果arr2(c，d) <>“或不跳过

您可以使用一个参数来帮助您决定如何处理错误--也许可以使用Enum：

Public Enum TEXTJOIN_ErrorValues
    ThrowOnError
    SkipError
    IncludeErrorText
End Enum

ThrowOnError将是当前/默认行为；SkipError将将错误视为空白，而IncludeErrorText将在结果中包含例如#N/A错误文本。

但是，一旦您有了一个Variant/Error值而不是一个Range，就不可能得到文本(除非您想要将CVErr(xlErrWhatever)值映射到相应的字符串.因此，对该枚举值进行划痕，则该行为要么抛出错误，要么跳过错误值。这是完全可能的，而且很容易做到--添加一个可选的Boolean参数可能会对此有所帮助。

Dim sb As StringBuilder
Set sb = New StringBuilder
'...

For currentRow = LBound(sourceArray, 1) To sourceRows
    For currentColumn = LBound(sourceArray, 2) To sourceColumns
        If Not IsError(sourceArray(currentRow, currentColumn)) Then
            If sourceArray(currentRow, currentColumn) <> vbNullString Or Not skipBlank Then
                sb.Append sourceArray(currentRow, currentColumn)
                sb.Append delim
            End If
        ElseIf Not skipErrors Then
            sb.Append delim
        End If
    Next
Next

TEXTJOIN = sb.ToString

这就是2D循环。一维循环做的事情基本上是一样的。这太烦人了。我想找个方法。

Private Sub ProcessValue(ByVal value As Variant, ByVal sb As StringBuilder, ByVal delim As String, ByVal skipBlanks As Boolean, ByVal skipErrors As Boolean)
    If Not IsError(value) Then
        If CStr(value) <> vbNullString Or Not skipBlanks Then
            sb.Append CStr(value)
            sb.Append delim
        End If
    ElseIf Not skipErrors Then
        sb.Append delim
    End If
End Sub

这将逻辑转化为：

If dimensionCount = 2 Then
    For currentRow = LBound(sourceArray, 1) To sourceRows
        For currentColumn = LBound(sourceArray, 2) To sourceColumns
            ProcessValue sourceArray(currentRow, currentColumn), sb, delim, skipBlanks, skipErrors
        Next
    Next
Else
    Debug.Assert dimensionCount = 1
    For currentRow = LBound(sourceArray, 1) To sourceRows
        ProcessValue sourceArray(currentRow), sb, delim, skipBlanks, skipErrors
    Next
End If

TEXTJOIN = sb.ToString

参数的顺序给我的印象是不直观的--可能是为了匹配Microsoft的功能而设计的，因为我会将源数组/范围作为第一个参数，然后是一个可选的分隔符，然后是跳过空白的可选标志(后面是跳过错误的可选标志)。

票数 7

Code Review用户

发布于 2017-11-13 18:00:19

免责声明:我知道你在问一个相对简单的问题，但这毕竟是CR .

检查数组和范围是非常好的(假设这个函数通常是从工作表中调用的)，但是有一些重要的注意事项要做。

首先，我花了几分钟来解码您的代码。鉴于您在社区中非常活跃(因此您正在帮助许多人)，因此值得投资于罗伯特C马丁( Robert )的“清洁代码”(Clean)副本。这是Mat's Mug推荐给我的一本书，它完全改变了我对代码的看法，以及我如何处理编码。

因此，我注意到的第一件事是，代码中的小东西是如何累积成更大的潜在bug的。例如：

On Error Resume Next
t = UBound(arr2, 2)
y = UBound(arr2, 1)
On Error GoTo 0

If t >= 0 And y >= 0 Then

...

End If

如果我正确地解释了这一点，您只是在测试数组中是否存在第二个维度，如果存在，则将数组循环为2d数组。否则，您将作为一个一维数组循环。如果我们能在VBA中明确地说出这一点，那不是很好吗？

Private Function ArrayIsTwoDimensional(ByVal TestArray As Variant) As Boolean
    Dim Test As Variant

    On Error Resume Next
    Test = TestArray(LBound(TestArray, 1), LBound(TestArray, 2))

    ' Note: This will work for a 3d array, or a 4d array, etc. If there is any risk of a higher-dimension array, use a function that returns
    ' the exact number of dimensions.
    ArrayIsTwoDimensional = (Err.Number = 0)
    On Error GoTo 0
End Function

Private Function JoinFromTwoDimensionalArray(ByVal Delimeter As String, ByVal SkipBlanks As Boolean, ByVal InputArray As Variant)
    Dim Join As String

    Dim i As Long
    For i = LBound(InputArray, 1) To UBound(InputArray, 1)
        Dim j As Long
        For j = LBound(InputArray, 2) To UBound(InputArray, 2)
            If InputArray(i, j) <> vbNullString Or Not SkipBlanks Then
                If Join <> vbNullString Then Join = Join & Delimeter
                Join = Join & InputArray(i, j)
            End If
        Next
    Next

    JoinFromTwoDimensionalArray= Join
End Function

Private Function JoinFromOneDimensionalArray(ByVal Delimeter As String, ByVal SkipBlanks As Boolean, ByVal InputArray As Variant) As String
    Dim Join As String

    Dim i As Long
    For i = LBound(InputArray) To UBound(InputArray)
        If InputArray(i) <> vbNullString Or Not SkipBlanks Then
            ' Note the placement of the delimeter forces the joined text to only ever add a delimeter when needed.
            If Join <> vbNullString Then Join = Join & Delimeter
            Join = Join & InputArray(i)
        End If
    Next i

    JoinFromOneDimensionalArray = Join
End Function

这是我为使您的代码变得更有意义而迈出的第一步。通过提取这两个循环，以及尺寸检查，主例程变得更加清晰，并且可以依靠几个Private Functions来完成它需要做的工作。这样做的好处是，您的代码现在明确地说明了它正在做什么(任何人都可以阅读代码，不管他们是已经编码了几天还是几年)。

下一步是显式检查所支持的类型。例如：

If TypeName(arr) = "Range" Then
    arr2 = arr.Value
Else
    arr2 = arr
End If

例如，如果arr是一个Worksheet，那么当试图将arr2分配给arr时，您将得到一个With block or Object variable not set错误(这里的名称也很麻烦)。如果有人传递我们当前不支持的值，那么我们显式地引发一个错误：

Private Const ERR_NUMBER_TYPE_NOT_SUPPORTED As Long = 513
Private Const ERR_MESSAGE_TYPE_NOT_SUPPORTED As String = "Please provide a Variant() or Range for the InputValues argument of TEXTJOIN. Alternate types are not currently supported."

Dim Values As Variant
Select Case TypeName(InputValues)
Case "Range"
    Values = InputValues.Value
Case "Variant()"
    Values = InputValues
Case Else
    Err.Raise ERR_NUMBER_TYPE_NOT_SUPPORTED, ERR_MESSAGE_TYPE_NOT_SUPPORTED
End Select

这里的优点是，我们的代码不仅会引发一个与问题来源明确相关的错误，而且我们还有一种非常模块化的方式来添加额外的支持。例如，如果我们想支持一个工作表(无论出于什么原因)，我们需要更新错误消息，并添加一些附加代码：

Dim Values As Variant
Select Case TypeName(InputValues)
Case "Range"
    Values = InputValues.Value
Case "Variant()"
    Values = InputValues
Case "Worksheet"
    Values = GetArrayFromWorksheet(InputValues)
Case Else
    Err.Raise ERR_NUMBER_TYPE_NOT_SUPPORTED, ERR_MESSAGE_TYPE_NOT_SUPPORTED
End Select

最后，对代码的可读性/可维护性有很大的影响。这是成品(功能相同)：

Private Const ERR_NUMBER_TYPE_NOT_SUPPORTED As Long = 513
Private Const ERR_MESSAGE_TYPE_NOT_SUPPORTED As String = "Please provide a Variant() or Range for the InputValues argument of TEXTJOIN. Alternate types are not currently supported."

Public Function TEXTJOIN(ByVal Delimeter As String, ByVal SkipBlanks As Boolean, ByVal InputValues As Variant) As String
    Dim Values As Variant
    Select Case TypeName(InputValues)
    Case "Range"
        Values = InputValues.Value
    Case "Variant()"
        Values = InputValues
    Case Else
        Err.Raise ERR_NUMBER_TYPE_NOT_SUPPORTED, ERR_MESSAGE_TYPE_NOT_SUPPORTED
    End Select

    If ArrayIsTwoDimensional(InputValues) Then
        TEXTJOIN = JoinFromTwoDimensionalArray(Delimeter, SkipBlanks, InputValues)
    Else
        TEXTJOIN = JoinFromOneDimensionalArray(Delimeter, SkipBlanks, InputValues)
    End If
End Function

Private Function ArrayIsTwoDimensional(ByVal TestArray As Variant) As Boolean
    Dim Test As Variant

    On Error Resume Next
    Test = TestArray(LBound(TestArray, 1), LBound(TestArray, 2))

    ' Note: This will work for a 3d array, or a 4d array, etc. If there is any risk of a higher-dimension array, use a function that returns
    ' the exact number of dimensions.
    ArrayIsTwoDimensional = (Err.Number = 0)
    On Error GoTo 0
End Function

Private Function JoinFromTwoDimensionalArray(ByVal Delimeter As String, ByVal SkipBlanks As Boolean, ByVal InputArray As Variant)
    Dim Join As String

    Dim i As Long
    For i = LBound(InputArray, 1) To UBound(InputArray, 1)
        Dim j As Long
        For j = LBound(InputArray, 2) To UBound(InputArray, 2)
            If InputArray(i, j) <> vbNullString Or Not SkipBlanks Then
                If Join <> vbNullString Then Join = Join & Delimeter
                Join = Join & InputArray(i, j)
            End If
        Next
    Next

    JoinFromTwoDimensionalArray= Join
End Function

Private Function JoinFromOneDimensionalArray(ByVal Delimeter As String, ByVal SkipBlanks As Boolean, ByVal InputArray As Variant) As String
    Dim Join As String

    Dim i As Long
    For i = LBound(InputArray) To UBound(InputArray)
        If InputArray(i) <> vbNullString Or Not SkipBlanks Then
            ' Note the placement of the delimeter forces the joined text to only ever add a delimeter when needed.
            If Join <> vbNullString Then Join = Join & Delimeter
            Join = Join & InputArray(i)
        End If
    Next i

    JoinFromOneDimensionalArray = Join
End Function

我们去掉所有这些反变量(选择i和j，这是非常标准的)。我们的其他变量是非常明确的名字，一切都是你所期望的。因此，如果您(无论从现在起多少年)回到函数添加新的东西，或者如果它中断了，您可以快速找到源，而不是试图记住什么是t和y，以及为什么将t或y设置为-1等等。

同样，强烈建议选择Clean Code的副本。抽象级别、函数、类等的概念一开始都很难理解，但是一旦你开始工作，你的代码就会变得容易阅读。

票数 5

Code Review用户

发布于 2017-11-14 08:03:54

我非常喜欢OP的概念，但我觉得伪Excel Application.WorksheetFunction.TextJoin函数应该采用混合数据类型的ParamArray。

在我的实现中，我使用字符串缓冲区和Mid函数的组合，通过避免连接大字符串来提高速度。为了测试我的函数的速度，我用长度从5到50个字符的随机字符串填充了500 K单元格。使用TheSpreadsheetGuru:计时器，我确定创建一个14,256,557个字符的字符串需要1.95秒。

我确信，通过使用@Mat‘’sMug提到的防雷StringBuilder，速度会提高5倍。我没有亲自使用它，因为我想让一个函数来完成所有的工作。

公式

=TextJoin2 2( "，"，FALSE，"Numbers"，A6:C6，A7:C9，{10,11,12}) =TextJoin2 2(“，”，真，“数字”，A6:C6，A7:C9，{10,11,12})

码

Function TextJoin2(Delimiter As String, Ignore_Emtpy As Boolean, ParamArray Args() As Variant) As Variant
    Dim results As String
    Dim count As Long, i As Long, j As Long, length As Long, pos As Long
    Dim argument As Variant, v As Variant

    Select Case TypeName(Args(0))
        Case "Empty"
            argument = Array()
        Case "Range"
            If Args(0).count = 1 Then
                argument = Array(Args(0).value)
            Else
                argument = Args(0).value
            End If
        Case "String"
            argument = Array(Args(0))
        Case "Variant()"
            argument = Args(0)
    End Select

    For Each v In argument
        length = length + Len(v)
        count = count + 1
    Next

    results = Space(length + count * Len(Delimiter))
    If count - 1 + LBound(argument) = UBound(argument) Then
        For Each v In argument
            If Not Ignore_Emtpy Or Len(v) > 0 Then
                Mid(results, pos + 1, Len(v) + Len(Delimiter)) = v & Delimiter
                pos = pos + Len(v) + Len(Delimiter)
            End If
        Next
    Else
        For i = LBound(argument) To UBound(argument)
            For j = LBound(argument, 2) To UBound(argument, 2)
                If Not Ignore_Emtpy Or Len(argument(i, j)) > 0 Then
                    Mid(results, pos + 1, Len(argument(i, j)) + Len(Delimiter)) = argument(i, j) & Delimiter
                    pos = pos + Len(argument(i, j)) + Len(Delimiter)
                End If
            Next
        Next
    End If
    
    'Trim results needed to adjust for skipping empty values
    results = Left(results, pos)
     
    For i = 1 To UBound(Args)
        results = results & TextJoin2(Delimiter, Ignore_Emtpy, Args(i)) & Delimiter
    Next
    
    Debug.Print Left(results, Len(results) - Len(Delimiter))
    TextJoin2 = Left(results, Len(results) - Len(Delimiter))
End Function

票数 2

页面原文内容由Code Review提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://codereview.stackexchange.com/questions/180332

复制

相似问题

问在我的TEXTJOIN UDF中对数组和范围的测试
EN

回答 3

Code Review用户

Code Review用户

免责声明:我知道你在问一个相对简单的问题，但这毕竟是CR .

Code Review用户

公式

码

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问在我的TEXTJOIN UDF中对数组和范围的测试EN

回答 3

Code Review用户

Code Review用户

免责声明:我知道你在问一个相对简单的问题，但这毕竟是CR .

Code Review用户

公式

码

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问在我的TEXTJOIN UDF中对数组和范围的测试
EN