Excel VBA（UDF）返回#值！由于255个字符的限制

我不太熟悉Excel中的VBA。我需要返回VBA函数文本值，而不考虑字符限制（如果需要限制，560就足够了）。我读过很多关于255个字符限制、包装文本或使用不同字符串等的论坛帖子，但我真的不明白如何在下面使用的代码中实现这一点

情况： 我每天都有一堆文件（纸质副本），每个文件都有一个7位数的数字ID。这总是7位数长。我在单元格B4中键入不带空格或逗号的值，然后在单元格B5中通过=InsertChar（B4）调用函数，该函数将用逗号分隔每个文档ID（每7位）。下面我从网上复制的代码可以很好地完成这项工作，它每7位插入一个逗号，直到单元格B5超过255个字符，在这种情况下它将返回“#VALUE！”

我尝试格式化单元格并添加一些wraptext代码（它确实包装了文本），但一旦单元格B5超过255个字符，它仍然返回“#VALUE！”而不是数字和逗号作为文本

如果有人能帮忙，我将不胜感激。这似乎是一个简单的解决方案，但我是VBA的新手，甚至连我使用过的一半代码都不懂。：）

NB:Office Excel 2016版和365版

单元格B4（不带逗号手动输入的虚拟数据）：

11872261184701186581118733511875623118765991187542311915545119155451191554611915547119156819156871187226111843701186581118733518756231187659111875423119155111155451191554611915547119156819156819156871

VBA代码：

Option Explicit

Function InsertChar(STR As String, Optional sInsertCharacter As String = ",", Optional lSpacing As Long = 7) As String
    Dim sCharString As String
    Dim sFormatString As String
    Dim sTemp As String
    Dim I As Long

For I = 1 To lSpacing
    sCharString = sCharString & "&"
Next I
sCharString = sCharString & sInsertCharacter

For I = 0 To Len(STR) \ lSpacing
    sFormatString = sFormatString & sCharString
Next I

sFormatString = "!" & Left(sFormatString, Len(sFormatString) - 1)

sTemp = Format(STR, sFormatString)
If Right(sTemp, 1) = "," Then sTemp = Left(sTemp, Len(sTemp) - 1)

InsertChar = sTemp


End Function

单元格B5（小于255个字符时更正VBA函数的结果）：

118722611847011865811187335118756231187659911875423119155451191554511915546119155471191561191568111872261118437011865811187335187562118765911875421191554119155411915681191568119156811915681191568119156811915191621

单元格B5（超过255个字符时VBA函数的结果不正确）：

---

#值

看起来错误是由于

格式

函数可以处理的字符限制

您需要考虑另一种不使用

格式的方法。比如说,

函数InsertChar（STR作为字符串，可选sInsertCharacter作为字符串=“，”，可选lspacking作为Long=7）作为字符串
模糊的RestChars作为字符串
RestChars=STR
当RestChars“”时执行此操作
InsertChar=InsertChar&Left$（RestChars，lSpacing）和sInsertCharacter
如果Len（RestChars）>lSpacing，则
RestChars=Right$（RestChars，Len（RestChars）-lSpacing）
其他的
RestChars=“”
如果结束
环
InsertChar=Left$（InsertChar，Len（InsertChar）-1）
端函数
我将函数复制到VBA编辑器中，并尝试从即时窗格运行。该函数位于以下行：

sTemp = Format(STR, sFormatString)

从我的测试来看，VBA函数似乎忽略了格式字符串中超过257个字符。例如，下面的表达式

' Generates a string composed of # characters, with a length of 272
' Pass that string as a format string to the Format function
' Return the length of the formatted string
Len(Format(5, String(272, "#")))

返回
257
，而不是
272

当截断为257个字符时，函数生成的格式字符串后面有一个逗号：

!&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,&&&&&&&,

这似乎是问题的根源


我建议直接在字符串上循环7个字符。大概是这样的：

Function InsertComma(s As String) As String
    Dim length As Integer
    length = Len(s)

    Dim result As String
    result = ""

    Dim i As Integer
    For i = 1 To length Step 7
        If i > 1 Then result = result & ","
        result = result & Mid(s, i, 7)
    Next

    InsertComma = result
End Function

或者，您可以使用正则表达式。添加对Microsoft VBScript正则表达式5.5库的引用（通过工具->引用…）

对
模式的解释
——我们试图找到：


每组正好有7位（
{7}
）数字（
\d
）
应将组捕获为子匹配（
（
…
）
）——我们需要它来使用
替换
方法
该组后面跟着另一个数字（
\d
）——这不包括字符串中的最后一个组，因为它后面没有另一个数字
但是后面的数字不应该是匹配结果的一部分（
（？=
…
）
，也称为正向前瞻）

在字符串中找到多个匹配项。我们希望用捕获的数字替换每个匹配项，后跟逗号。在正则表达式语法中，它写为：

$1,

（注意，VBA中的
RegExp.Replace
方法不能将
$0
识别为替换为整个匹配项，这就是我们需要捕获组的原因；与.NET正则表达式不同。）


VBA参考：








VBScript正则表达式库引用（可从VBA使用）：




和属性


这似乎没有字符限制

以7个字符为例

=SplitIt（A1，“，”7）

下面是另一个解决方案，使用：


B1
中的公式，下拉：

=InsertChar(A1,",",7)


注意1:
.Evaluate
使用包含公式的字符串计算最多255个字符。因此，我在函数中使用了范围引用而不是字符串引用。现在，公式的计算结果是
{IF（行（1:31），MID（$A$1，（行（1:31）*7）-6,7），“”）}
，其中VBA认识到我们希望它是一个数组公式（因此返回一个值数组）

注2:我们必须
将二维数组转换为一维数组，才能在
连接中使用它
函数是否从即时窗格返回正确的结果？在VBA编辑器打开的情况下，按CTRL+G键进入即时窗格。然后是Function SplitIt(s As String, sep As String, charCnt)
    Dim rSult As String, y As Long
    Dim a, b, c
    Dim Ls As String
    a = 0
    b = charCnt
    c = charCnt

    's = [A1].Value

    For y = 1 To Len(s) / c
        Ls = Mid(s, a + 1, c)
        rSult = rSult & sep & Ls
        a = a + c
    Next

    If Left(rSult, 1) = sep Then rSult = Mid(rSult, 2, Len(rSult))
    SplitIt = rSult

End Function

Function InsertChar(rng As Range, sInsertCharacter As String, lSpacing As Long) As String
    arr = Application.Evaluate("TRANSPOSE(IF(ROW(1:" & Len(rng.Value) / lSpacing & "), MID(" & rng.Address & ",(ROW(1:" & Len(rng.Value) / lSpacing & ")*7)-6,7),"" ""))")
    InsertChar = Join(arr, sInsertCharacter)
End Function

=InsertChar(A1,",",7)