以数组作为返回值的 VBA 函数

VBA function with an array as return value

提问by sebastien leblanc

I have the following code:

我有以下代码：

Function TruncateString(str, n)
    ' Returns an array with strings no more than n char long, truncated at spaces
    Dim truncatedArr() As String
    If str <> "" Then
            str = remove_spaces_left(str)
        For i = 0 To (CLng(Len(str) / n))
            Index = InStrRev(Left(str, n), " ")
            ReDim Preserve truncatedArr(i)
            truncatedArr(i) = Left(str, Index)
            If Right(truncatedArr(i), 1) = " " Then truncatedArr(i) = Left(truncatedArr(i), Len(truncatedArr(i)) - 1)
            str = Right(str, Len(str) - Index)
        Next i
    End If
    TruncateString = truncatedArr
End Function

My question is what is the value returned by the function when stris empty? I have a type compatibility issue when I do
arr = TruncateString (text,15)

我的问题是函数str为空时返回的值是多少？当我这样做时，我遇到了类型兼容性问题
arr = TruncateString (text,15)

arr is defined like this:
dim arr() as string

arr 定义如下：
dim arr() as string

please let me know if more info is needed for an answer. Thanks

如果答案需要更多信息，请告诉我。谢谢

回答by JMax

You have several issues in your code:

您的代码中有几个问题：

• you should use Option Explicitat the begining of the Module so that you will get forced to declare allyour variables (including iand Index, which should get renamed because it raises a conflict with a Property)
• your code doesn't work if there is no space within the selected range of characters (return an empty string)

• 您应该Option Explicit在模块的开头使用，以便您将被迫声明所有变量（包括iand Index，应该重命名，因为它会引发与属性的冲突）
• 如果所选字符范围内没有空格，您的代码将不起作用（返回空字符串）

And eventually, to answer your question (but I wonder why you didn't check it by yourself), your function returns an empty array (exists but never ReDimed). You can't even UBoundsuch an array.

最后，为了回答您的问题（但我想知道您为什么不自己检查），您的函数返回一个空数组（存在但从未ReDim编辑过）。你甚至不能UBound这样一个数组。

回答by brettdj

I thought this was an interesting coding task, below are two attempts of mine to write a more efficient function that "chops up"a large string by

我认为这是一个有趣的编码任务，下面是我的两次尝试写一个更有效率的函数，“砍了”由大串

• Space [CHR(32)]
• then into fixed lengths

• then with any residual length carried over

  1. My preferred method uses a rexexpto break the string up immediately
  2. The second method runs 3 string manipulations and to me feels uglier and more complex
     • uses Splitto separate the string into smaller text chunks using a space character as a delimiter
     • loops through each element of this array and breaks this up into fixed length chucks using Mid$
     • tests if any strings less than the desired fixed length chunks are left (with a Modtest), if so appends these partial strings to the final outcome

• 空间 [CHR(32)]
• 然后固定长度

• 然后将任何剩余长度结转

  1. 我的首选方法使用 arexexp立即断开字符串
  2. 第二种方法运行 3 个字符串操作，对我来说感觉更丑更复杂
     • 用于Split使用空格字符作为分隔符将字符串分成更小的文本块
     • 循环遍历此数组的每个元素，并使用以下命令将其分解为固定长度的夹头 Mid$
     • 测试是否还有小于所需固定长度块的字符串（通过Mod测试），如果是，则将这些部分字符串附加到最终结果

Both functions return an array by splitting the final text, which I then have returned as a single string using Joinin my master sub.

这两个函数都通过拆分最终文本返回一个数组，然后我将其作为单个字符串返回Join到我的主子程序中。

Code

代码

Sub Test()
    Dim strIn As String
    Dim lngChks As Long
    strIn = Application.Rept("The quick fox jumped over the lazy dog", 2)
    lngChks = 2
    MsgBox Join(TruncateRegex(strIn, lngChks), vbNewLine)
    MsgBox Join(TruncateMid(strIn, lngChks), vbNewLine)
End Sub

1 - Regexp

1 - 正则表达式

Function TruncateRegex(ByVal strIn, ByVal lngChks)
    Dim objRegex As Object
    Dim objRegMC As Object
    Dim objRegM As Object
    Dim strOut As String
    Dim lngCnt As Long
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Pattern = "[^\s]{1," & lngChks - 1 & "}(\s+|$)|[^\s]{" & lngChks & "}"
        .Global = True
        'test to avoid nulls
        If .Test(strIn) Then
            Set objRegMC = .Execute(strIn)
            For Each objRegM In objRegMC
                'concatenate long string with (short string & short string)
                strOut = strOut & (objRegM & vbNewLine)
            Next
        End If
    End With
    TruncateRegex = Split(strOut, vbNewLine)
End Function

2-String

2-字符串

Function TruncateMid(ByVal strIn, ByVal lngChks)
    Dim arrVar
    Dim strOut As String
    Dim lngCnt As Long
    Dim lngCnt2 As Long
    'use spaces to delimit string array
    arrVar = Split(strIn, Chr(32))
    For lngCnt = LBound(arrVar) To UBound(arrVar)
        If Len(arrVar(lngCnt)) > 0 Then
            lngCnt2 = 0
            For lngCnt2 = 1 To Int(Len(arrVar(lngCnt)) / lngChks)
                strOut = strOut & (Mid$(arrVar(lngCnt), (lngCnt2 - 1) * lngChks + 1, lngChks) & vbNewLine)
            Next
            'add remaining data at end of string < lngchks
             If Len(arrVar(lngCnt)) Mod lngChks <> 0 Then strOut = strOut & (Mid$(arrVar(lngCnt), (lngCnt2 - 1) * lngChks + 1, Len(arrVar(lngCnt)) Mod lngChks) & vbNewLine)
        End If
    Next
    TruncateMid = Split(strOut, vbNewLine)
End Function