将 Excel 范围转换为 VBA 字符串答案

【问题标题】：Turn Excel range into VBA string将 Excel 范围转换为 VBA 字符串
【发布时间】：2017-01-28 14:36:43
【问题描述】：

我想将给定范围内的值转换为 VBA 字符串，其中原始单元格值由任何选定的列分隔符和行分隔符分隔。分隔符可以是一个字符或更长的字符串。行分隔符是行尾的字符串。字符串应该就像我们从左上角，从左到右，到右下角读取文本一样完成。

这是 A1:C5 范围内的 VALUES 示例：

+----+----+----+
| A1 | B1 | C1 |
+----+----+----+
| A2 | B2 | C2 |
+----+----+----+
| A3 | B3 | C3 |
+----+----+----+
| A4 | B4 | C4 |
+----+----+----+
| A5 | B5 | C5 |
+----+----+----+

期望的结果是一个 VBA 字符串：

A1,B1,C1@$A$2,$B$2,$C$2@A3,B3,C3@A4,B4,C4@A5,B5,C5@

为了便于阅读，我会这样显示：

A1,B1,C1@
A2,B2,C2@
A3,B3,C3@
A4,B4,C4@
A5,B5,C5@

我选择了,（逗号）作为列分隔符，并选择了@ 符号作为行分隔符。当然这些可以是任何字符，例如\r\n。

我想要从范围快速烹饪字符串的原因是因为我想通过 ADO 连接将它发送到 SQL Server。正如我到目前为止所测试的那样，它是即时传输大量数据的最快方式。如何在 SQL Server 上拆分此字符串的孪生问题在这里：Split string into table given row delimiter and column delimiter in SQL server

解决方案 1. 循环遍历所有行和列。问题是是否有任何更优雅的方式，然后只是循环遍历所有行和列？我更喜欢 VBA 解决方案，而不是公式一。

解决方案 2。 由 Mat's Mug 在评论中建议。 CSV 文件是所需的结果。我想在不保存的情况下即时进行。但好的一点 - 模仿 CSV 是我想要的，但我想要它而不保存。

赏金后编辑

Thomas Inzina 的答案工作得非常快，而且他的解决方案是可移植的。事实证明，普通 VBA 循环比大型数据集上的 JOIN 等工作表函数要快得多。为此，我不建议在 VBA 中使用工作表函数。我已经投票给每个人。谢谢大家。

【问题讨论】：

首先想到的是 Save As -> CSV - 如果需要，然后将文件读入字符串。问题是为什么你需要一个以逗号分隔的字符串中的单元格值列表？
重新更新 - 您不打算在 INSERT 语句中使用它，是吗？如果是这种情况，您可能需要重新考虑这一点并改用参数化查询。
感谢您的提示。 @Comintern 是的，不幸的是我想这样做。我在这里知道其他类似的解决方案：excel-sql-server.com 但是，具有一个大参数的存储过程 - 字符串 - 后来在 SQL 服务器上被切割成碎片以进行插入是最快的解决方案。比我所知道的 Excel 方面的所有解决方案都要快得多。
我看到赏金仍然开放 - 有什么没有正确完成的答案？我们缺少什么？
我相信我的函数将成为构建字符串的最快方法，但是，由于它的多功能性，我会使用 ADO Recordset.getString 方法来构建它。

标签： arrays string vba excel

【解决方案1】：

为了优化性能，我的函数模拟了一个字符串生成器。

变量

文本：用于保存数据的非常大的字符串
CELLLENGTH：确定 BufferSize 大小的常量
BufferSize：文本字符串的初始大小
Data()：从源范围派生的数组

由于 Data() 数组的行和列在当前元素 (Data(x, y)) 上进行迭代，因此值替换了文本字符串的一部分。根据需要调整文本字符串的大小。这极大地减少了连接的数量。初始 BufferSize 设置得相当高。通过将 CELLLENGTH 减少到 25，我得到了最好的结果，0.8632813 秒。

Download Sample Data from Sample-Videos.com

结果

代码

Function getRangeText(Source As Range, Optional rowDelimiter As String = "@", Optional ColumnDelimiter As String = ",")
    Const CELLLENGTH = 255
    Dim Data()
    Dim text As String
    Dim BufferSize As Double, length As Double, x As Long, y As Long
    BufferSize = CELLLENGTH * Source.Cells.Count
    text = Space(BufferSize)

    Data = Source.Value

    For x = 1 To UBound(Data, 1)
        If x > 1 Then
            Mid(text, length + 1, Len(rowDelimiter)) = rowDelimiter
            length = length + Len(rowDelimiter)
        End If

        For y = 1 To UBound(Data, 2)
            If length + Len(Data(x, y)) + 2 > Len(text) Then text = text & Space(CDbl(BufferSize / 4))
            If y > 1 Then
                Mid(text, length + 1, Len(ColumnDelimiter)) = ColumnDelimiter
                length = length + Len(ColumnDelimiter))
            End If

            Mid(text, length + 1, Len(Data(x, y))) = Data(x, y)
            length = length + Len(Data(x, y))
        Next
    Next

    getRangeText = Left(text, length) & rowDelimiter
End Function

测试

Sub TestGetRangeText()
    Dim s As String
    Dim Start: Start = Timer

    s = getRangeText(ActiveSheet.UsedRange)

    Debug.Print "Execution Time: "; Timer - Start; "Second(s)"
    Debug.Print "Rows: "; ActiveSheet.UsedRange.Rows.Count; "Columns: "; ActiveSheet.UsedRange.Columns.Count
    Debug.Print "Result Length: "; Format(Len(s), "#,###")
End Sub

【讨论】：

你能简单解释一下你的UDF的逻辑吗？缓冲是为了什么？字符串是如何构造的？
本文：MSDN: How To Improve String Concatenation Performance 每次连接字符串时都会创建一个临时内存位置，第一个字符串被复制到临时内存中，第二个字符串被复制到临时内存的末尾，然后调整目标字符串的大小，将内存从临时内存复制到新调整大小的内存，并清理旧变量。
在我的测试中，我将 535,563 个单元格与另外 535,563 个分隔符组合在一起。我没有执行 1,071,126 次连接，而是创建了一个足够大的缓冲字符串来容纳所有数据。如果我的缓冲区太小，它将连接另一个非常大的字符串。最多将连接数减少到 2 或 3。我从来没有学过计算机科学，但是每次串联 6 次操作，这将操作总数从超过 600 万减少到 535,563 + (6 + 6 + 1) ish。
根据那篇文章，它比连接字符串快 100 倍。
感谢@SMeaden。当时我不知道我们可以使用 CreateObject("System.Text.StringBuilder")。 Access: using .Net strings in VBA for fun and profit | Cypris' lookout 在包装 StringBuilder 方面做得非常出色。用实际的 StringBuilder 测试我的代码会很有趣。

【解决方案2】：

这是一种快速测试方法（注意：这仅适用于 Excel 2016（或者如果您有 TextJoin() 函数）。

首先，在空列 D 中，执行=C1&"@"，这样你的最后一列就会被单元格+@ 填充

然后，在单元格 E1 中说，=TEXTJOIN(",",TRUE,A1:C5) （注意：TRUE 表示跳过空格。如果您有空格，并且想保留它们，请将其更改为FALSE）。

然后，在那个单元格上运行

=Substitute(E1,"@,","@")

或者将公式合二为一：=SUBSTITUTE(TEXTJOIN(",",TRUE,A1:C4),"@,","@")。

如果您需要 vba，只需将公式放入 VBA 宏中并像这样运行。

【讨论】：

仅供参考，这个 UDF 在某种程度上模仿了 TEXTJOIN()：stackoverflow.com/questions/39532189/…
@ScottCraner - 是的，我认为TextJoin 可能是 Excel 人员收到的很多请求，他们实现了它。 OP - 如果您没有 Excel 2016，请查看 Scott 提供的链接。

【解决方案3】：

这是一个返回所需输出的 UDF：

EDIT更改为在末尾添加 EOL。

Option Explicit
Function MultiJoin(Rng As Range, Delimiter As String, EOL As String) As String
    Dim V As Variant, W As Variant
    Dim COL As Collection
    Dim I As Long, J As Long

V = Rng
Set COL = New Collection
ReDim W(1 To UBound(V, 2))
For I = 1 To UBound(V, 1)
    For J = 1 To UBound(V, 2)
        W(J) = V(I, J)
    Next J
    COL.Add W
Next I

ReDim V(1 To COL.Count)
For I = 1 To COL.Count
    V(I) = Join(COL(I), Delimiter)
Next I

W = Join(V, EOL)
MultiJoin = W & EOL

End Function

使用WorksheetFunctions 可以缩短代码，但我猜执行时间会更慢。

短代码

Option Explicit
Function MultiJoin(Rng As Range, Delimiter As String, EOL As String) As String
    Dim V As Variant, W As Variant
    Dim I As Long, J As Long

V = Rng
With WorksheetFunction

For I = 1 To UBound(V, 1)
    V(I, 1) = Join(.Index(V, I, 0), Delimiter)
Next I
MultiJoin = Join(.Transpose(.Index(V, 0, 1)), EOL) & EOL

End With

End Function

【讨论】：

非常感谢。那是很棒的代码。 Set COL = New Collection 的行是什么？什么是新系列？
@PrzemyslawRemin 它是 Collection 对象的一个新实例。 Collection 对象用于收集包含每行元素的数组，以便稍后使用适当的分隔符进行Join ing。
您的两种解决方案都不会在最后一个矩阵元素 ($C$5) 之后添加 EOL。
@PrzemyslawRemin 如果您需要，这是一个微不足道的修改。查看编辑。
为什么最后的 EOL 没有像之前的兄弟一样加入？ Join 是一样的吗？

【解决方案4】：

此解决方案需要在您的项目中引用 Microsoft Forms 2.0 对象库，或以其他方式获取剪贴板的内容（例如通过 API 调用）。

Function TurnExcelRangeIntoVBAString(Optional cellDelimiter As String = ",", _
                                     Optional rowDelimiter As String = "@") _
         As String

    Dim rng As Range
    Set rng = ActiveSheet.UsedRange
    rng.Copy

    Dim clip As New MSForms.DataObject
    Dim txt As String
    clip.GetFromClipboard
    txt = clip.GetText()
    txt = Replace(Replace(txt, vbTab, cellDelimiter), vbCrLf, rowDelimiter)

    TurnExcelRangeIntoVBAString = txt
End Function

【讨论】：

这是非常优雅的短代码，外部引用是一个很大的缺点，因为解决方案将被不同的用户使用。
可以通过后期绑定消除外部引用：Dim clip as Object，使用Set clip =CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
@PrzemyslawRemin - Microsoft Forms 2.0 根本不应该成为问题 - 无论如何，只要您插入 UserForm，它就会自动添加。
@Comintern 或 activeX 控件

【解决方案5】：

你可以试试这个

Option Explicit

Sub main()
    Dim strng As String
    Dim cell As Range

    With Worksheets("TurnRangeIntoString") '<--| change "TurnRangeIntoString" to your actual worksheet name
        For Each cell In Intersect(.UsedRange, .Columns(1)) '<--| loop through its column 1 cells
            strng = strng & Join(Application.Transpose(Application.Transpose(.Range(cell, cell.End(xlToRight)).value)), ",") & "@" '<--| build string
        Next cell
    End With
    MsgBox strng
End Sub

【讨论】：

@PrzemyslawRemin，你通过了吗？
好的，谢谢。效果很好。我也喜欢你的想法。投票赞成。如果它是像 Ron Rosenfeld 提出的那样的函数，你的解决方案会更好，因为它允许选择精确的范围。
不客气。感谢您的支持。将我的 Sub 转换为函数非常简单，就像您在 Ron 解决方案中看到的那样。很好，你找到了最合适的！
看，这不是我和罗恩之间的比赛。这是一个帮助你的机会。我自己会感激的最大帮助就是帮助我学习。也就是说，您尝试将我的 Sub 转换为 Function，如果遇到问题，只需发布一个新帖子，展示您的努力并告诉他们哪里出了问题。
感谢您的贡献。如果可能的话，我会接受这两个答案。在我的测试中，您的解决方案似乎非常快。

【解决方案6】：

Sub aquatique()
dim a(),s$,i&,j&:a=selection.value
for i=1 to ubound(a)
for j=1 to ubound(a,2)
    if j=1 then
        if i=1 then
            s=  a(i,j)
        else
            s=s &"@" & vbnewline & a(i,j)
        end if
    else
        s=s &";" & a(i,j)
    end if
next
next
end sub

简单但能胜任。在大范围内慢，你需要使用“加入”

【讨论】：

【解决方案7】：

这个怎么样？

Sub Concatenate()
Dim Cel As Range, Rng As Range
Dim sString As String, r As Long, c As Long, r2 As Long

Set Rng = Selection
r = Selection.Row
c = Selection.Column
r2 = Selection.Row
For Each Cel In Rng
    r = Cel.Row
    If sString = "" Then
        sString = Cel.Value
        Else
            If r <> r2 Then sString = sString & "@" & Cel.Value
            If r = r2 Then sString = sString & "," & Cel.Value
    End If
    r2 = Cel.Row
Next

sString = sString & "@"
Debug.Print sString

End Sub

【讨论】：