将数组另存为 VBA 中的制表符分隔文本文件

Question

Sub ExportDataTSV()
Dim BCS As Worksheet
Dim Ctrl As Worksheet
Dim ws As Worksheet
Dim FName As String
Dim insertValues As String

Application.ScreenUpdating = False

Set BCS = ThisWorkbook.Sheets(Sheet2.Name)
Set Ctrl = ThisWorkbook.Sheets(Sheet1.Name)

#If Mac Then
    NameFolder = "documents folder"

    If Int(Val(Application.Version)) > 14 Then
    'You run Mac Excel 2016
    folder = _
    MacScript("return POSIX path of (path to " & NameFolder & ") as string")
    'Replace line needed for the special folders Home and documents
    folder = _
    Replace(SpecialFolder, "/Library/Containers/com.microsoft.Excel/Data", "")
    Else
    'You run Mac Excel 2011
    folder = MacScript("return (path to " & NameFolder & ") as string")
    End If
    
    FName = folder & "bcs_output.tsv"
#Else
    folder = Environ$("userprofile")
    Debug.Print folder
    FName = folder & "Documents\bcs_output.tsv"
#End If

If Ctrl.Range("D9") = "" Or Ctrl.Range("D10") = "" Then
    MsgBox "Please enter the Scenario Year and Scenario you wish to save and click again", vbOKOnly
    Exit Sub
End If

Ctrl.Range("D9").Copy
BCS.Range("AS2").PasteSpecial Paste:=xlPasteValues

Ctrl.Range("D10").Copy
BCS.Range("AT2").PasteSpecial Paste:=xlPasteValues

With BCS
    numrows = .Cells(.Rows.Count, 1).End(xlUp).Row
    numcol = .Cells(2, Columns.Count).End(xlToLeft).Column
    .Range("AS1").Value = "scenario_year"
    .Range("AS2:AS" & numrows).FillDown
    .Range("AT1").Value = "scenario"
    .Range("AT2:AT" & numrows).FillDown
    .Range("AU1").Value = "save_date"
    .Range("AU2").Formula = "=NOW()"
    .Range("AU2:AU" & numrows).FillDown
    .Range("AU2:AU" & numrows).NumberFormat = "yyyy-mm-dd hh:mm"
    For x = 2 To numrows
        Set rng1 = .Range("A" & x & ":R" & x)
        Set rng2 = .Range("AC" & x & ":AF" & x)
        Set rng3 = .Range("AH" & x & ":AK" & x)
        Set rng4 = .Range("AN" & x & ":AO" & x)
        Set rng5 = .Range("AS" & x & ":AU" & x)
        Set Data = Union(rng1, rng2, rng3, rng4, rng5)
    
        insertValues = Join2D(ToArray(Data), Chr(9))
        Debug.Print insertValues
        Call ConvertText(FName, insertValues)
    Next x
End With

With BCS
    .Activate
    .Range("A1").Select
End With

Ctrl.Activate
Application.ScreenUpdating = True

MsgBox "Cluster Data saved to your documents folder, please upload the file here: ", vbOKOnly

End Sub

Function ToArray(rng) As Variant()
    Dim arr() As Variant, r As Long, nr As Long
    Dim ar As Range, c As Range, cnum As Long, rnum As Long
    Dim col As Range

    nr = rng.Areas(1).Rows.Count
    ReDim arr(1 To nr, 1 To rng.Cells.Count / nr)
    cnum = 0
    For Each ar In rng.Areas
        For Each col In ar.Columns
        cnum = cnum + 1
        rnum = 1
        For Each c In col.Cells
            arr(rnum, cnum) = c.Value
            rnum = rnum + 1
        Next c
        Next col
    Next ar

    ToArray = arr
End Function
Public Function Join2D(ByVal vArray As Variant, Optional ByVal sWordDelim As String = " ", Optional ByVal sLineDelim As String = vbNewLine) As String
    
    Dim i As Long, j As Long
    Dim aReturn() As String
    Dim aLine() As String
    
    ReDim aReturn(LBound(vArray, 1) To UBound(vArray, 1))
    ReDim aLine(LBound(vArray, 2) To UBound(vArray, 2))
    
    For i = LBound(vArray, 1) To UBound(vArray, 1)
        For j = LBound(vArray, 2) To UBound(vArray, 2)
            'Put the current line into a 1d array
            aLine(j) = vArray(i, j)
        Next j
        'Join the current line into a 1d array
        aReturn(i) = Join(aLine, sWordDelim)
    Next i
    
    Join2D = Join(aReturn, sLineDelim)
    
End Function
Function ConvertText(myfile As String, strTxt As String)
    Dim objStream

    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        '.Close
    End With
    'Set objStream = Nothing

End Function

我尝试通过上述方法将非连续范围写入制表符分隔文件。我收到 3004 错误 - 无法从该代码写入文件。我不确定为什么它不能写文件，因为我什至不能写文件，所以我不知道它是否会写每一行数据，直到没有更多。谁能至少帮助我写文件？

Answer 1

您需要用反斜杠分隔 folder 和 "Documents\bcs_output.tsv"。在 MacOS 中，我认为路径分隔符是“:”（冒号），而不是“\”（反斜杠）。

将数组另存为 VBA 中的制表符分隔文本文件

Save Array as Tab Delimited Text file in VBA

excel

vba

adodb