excel - 在 VBA 中将数组另存为制表符分隔的文本文件
问题描述
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 错误 - 无法从该代码写入文件。我不知道为什么它不能写文件,因为我什至不能写文件,我不知道它是否会写每一行数据,直到没有更多的数据。任何人都可以协助至少帮助我编写文件吗?
解决方案
您需要用反斜杠分隔folder
和。"Documents\bcs_output.tsv"
在 MacOS 中,我相信路径分隔符是“:”(冒号),而不是“\”(反斜杠)。
推荐阅读
- dynamics-crm - 无法取消任务
- node.js - 无法使用 aws-s3-zipper 和节点 js 压缩 s3 存储桶中存在的文件
- machine-learning - 使用我的汽车数据集进行机器学习
- linux - 网络摄像头罗技和 Linux
- python - 如何根据分区将numpy 2d数组的行加在一起
- python - tf.image.crop_and_resize 用于 3D 图像
- dojo - 在文件夹树中打开特定文件夹(IBM Content Navigator)
- javascript - 如何使用highcharts,javascript绘制小时和分钟值(hh:mm)饼图
- ruby - 如果值存在,则显示哈希的内容
- javascript - return ''; 之间的差异 并返回;在javascript中