将Excel范围转换为VBA字符串

Question

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

以下是范围A1中的VALUES示例:C5:

+----+----+----+
| 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上拆分此字符串的孪生问题在于:在SQL Server 中给定行分隔符和列分隔符的情况下将字符串拆分为表

解决方案1.遍历所有行和列.问题是,如果有更优雅的方式,然后循环所有行和列？我更喜欢VBA解决方案,而不是公式一.

解决方案2. Mat's Mug在评论中提出建议.CSV文件是理想的结果.我想在不保存的情况下即时完成.但好点 - 模仿CSV是我想要的,但我想要它而不保存.

赏金后编辑

Thomas Inzina的答案疯狂快速,他的解决方案是便携式的.普通的VBA循环比大型数据集上的JOIN等工作表函数更快.我不建议在VBA中使用工作表函数来实现此目的.我已经投票给所有人.谢谢你们.

Answer 1

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

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

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

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

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

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

如果您需要vba，只需将公式放入 VBA 宏并运行即可。

Answer 2

为了优化性能,我的函数模拟了一个String Builder.

变量

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

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

从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