首页 > 解决方案 > 如何在同一个 Excel 电子表格(VBA)中将多个行块写入单独的文件?

问题描述

我完全是 VBA 文盲,所以如果这看起来微不足道,我深表歉意。我在 Excel 电子表格中有一个简单的数据集,它有 400 行和 3 列。它分组为 4 行的较小集合(1 行标题和 3 行数据),如下所示:

Set1    A   B
1      2.5  1.25
2      4.2  3.35
3      6.7  5.75
Set2    A   B
1      3.3  1.65
2      4.1  1.1
3      2.2  7.59
Set3    A   B
1      5.4  2.7
2      3.9  3.35
3      6.7  12.42

我想做的是

  1. 每 4 行(标题和数据)块写入单个制表符分隔的 .txt 文件
  2. 使用组名(例如 Set1)作为输出文件名(例如 Set1.txt)

我有限的理解是我需要

很抱歉,我什至无法提供一小段代码作为入门。我只是很难解析在这个站点和其他站点上可以找到的各种 VBA 代码。

标签: excelvba

解决方案


尝试

Sub test()
    Dim rngDB As Range, rng As Range
    Dim r As Long, i As Long
    Dim Fn As String, myPath As String

    myPath = ThisWorkbook.Path & "\"
    Set rngDB = Range("a1").CurrentRegion

    r = rngDB.Rows.Count

    With rngDB
        For i = 1 To r Step 4
            Set rng = .Range("a" & i).Resize(4, 3)
            Fn = myPath & .Range("a" & i) & ".txt"
            TransToText rng, Fn
        Next i
    End With
End Sub
Sub TransToText(rng As Range, strFile As String)
    Dim vDB, vR() As String, vTxt()
    Dim i As Long, j As Integer, n As Long
    Dim objStream

    Set objStream = CreateObject("ADODB.Stream")

    vDB = rng

    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, vbTab)
    Next i
    strtxt = Join(vTxt, vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strtxt
        .SaveToFile strFile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

推荐阅读