怎样更快将数组导出为文本

爱疯 · 发表于 2013-12-10 09:55

比如数组是这样子的：
选择A1:J100000，输入"=Rand()"，Ctrl+回车，复制，选A1，选择性粘贴值。

希望导出为文本文件(*.txt)，数组元素之间就用空格间隔吧。
请问如题？谢谢！

Dj_soo · 发表于 2013-12-10 10:17

直接另存为txt格式应该是一个比较方便的方法,但是不知道效率如何.

爱疯 · 发表于 2013-12-10 10:34

Dj_soo 发表于 2013-12-10 10:17
直接另存为txt格式应该是一个比较方便的方法,但是不知道效率如何.

Sub test()
' ActiveWorkbook.SaveAs Filename:="c:\abc.txt", FileFormat:=xlCurrentPlatformText '间隔较宽，不知怎样规定的
' ActiveWorkbook.SaveAs Filename:="c:\abc.txt", FileFormat:=xlTextMac
' ActiveWorkbook.SaveAs Filename:="c:\abc.txt", FileFormat:=xlTextMSDOS
' ActiveWorkbook.SaveAs Filename:="c:\abc.txt", FileFormat:=xlTextPrinter '有的无间隔
' ActiveWorkbook.SaveAs Filename:="c:\abc.txt", FileFormat:=xlTextWindows
' ActiveWorkbook.SaveAs Filename:="c:\abc.txt", FileFormat:=xlUnicodeText '间隔较宽，不知怎样规定的
'
'其它几种都是运行时错误1004:方法'SaveAs'作用于对象'_Workbook'时失败
End Sub

难道只有ActiveWorkbook.SaveAs 才能更快？
难道以下办法都只是花拳绣腿，处理数据量一大，就不如ActiveWorkbook.SaveAs？

1) Print # 语句

Sub txt_1()
Open "d:\2.txt" For Output As #1
Print #1, "你好！"
Close #1
End Sub

2) Put 语句

Sub txt_2()
Open "d:\2.txt" For Binary As #1
Put #1, , "你还好！"
Close #1
End Sub

3) Write # 语句

Sub txt_3()
Open "d:\2.txt" For Output As #1
Write #1, "你总好！"
Close #1
End Sub

4) WriteLine 方法

Sub txt_4()
Dim fs, a, arr
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("d:\2.txt", True)
a.WriteLine ("你还好！")
a.Close
End Sub

5) Write 方法

Sub txt_5()
Dim fs, a, arr
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("d:\2.txt", True)
a.Write ("老是你好！")
a.Close
End Sub

Dj_soo · 发表于 2013-12-10 10:52

额,效率上真没测试过,很少用txt处理..

爱疯 · 发表于 2013-12-10 10:58

Dj_soo 发表于 2013-12-10 10:52
额,效率上真没测试过,很少用txt处理..

我也没测试过，等有空再试

轩辕轼轲 · 发表于 2013-12-10 11:00

Option Explicit
Sub PrintText()
Dim myFileName As String
Dim myDataAr() As Variant
Dim myStr As String
Dim myRow As Long
Dim myCol As Long
Dim i As Long
Dim j As Long
On Error Resume Next
myFileName = "文本数据.txt"
Kill ThisWorkbook.Path & "" & myFileName
With Sheets(1)
myRow = .Cells(.Columns(1).Rows.Count, 1).End(xlUp).Row
myCol = .Cells(1, .Rows(1).Columns.Count).End(xlToLeft).Column
ReDim myDataAr(1 To myRow, 1 To myCol)
myDataAr = .Range(.Cells(1, 1), .Cells(myRow, myCol))
For i = 1 To myRow
For j = 1 To myCol
myDataAr(i, j) = .Cells(i, j).Value
Next
Next
Open ThisWorkbook.Path & "" & myFileName For Output As #1
For i = 1 To UBound(myDataAr, 1)
myStr = ""
For j = 1 To UBound(myDataAr, 2)
myStr = myStr & CStr(myDataAr(i, j)) & " "
Next
myStr = Left(myStr, (Len(myStr) - 1))
Print #1, myStr
Next
Close #1
End With
MsgBox "文件保存成功!"
End Sub

复制代码

执行时间的确稍微长一点，保存的txt文件16M多，有情可原。

爱疯 · 发表于 2013-12-10 11:09

轩辕轼轲发表于 2013-12-10 11:00
执行时间的确稍微长一点，保存的txt文件16M多，有情可原。

谢谢轩辕轼轲！

For i = 1 To myRow
      For j = 1 To myCol
         myDataAr(i, j) = .Cells(i, j).Value
      Next
Next
为什么不直接入赋给数组，而从单元格一个个读取呀？是有别的意义么

轩辕轼轲 · 发表于 2013-12-10 11:16

删除这段就可以了。前面有一个赋值给数组的，我是用我原来写的一段代码来改的。

轩辕轼轲 · 发表于 2013-12-10 11:38

爱疯发表于 2013-12-10 11:09
谢谢轩辕轼轲！

For i = 1 To myRow

Option Explicit
Sub PrintText()
Dim myFileName As String
Dim myDataAr, t
Dim myStr As String
Dim myRow As Long
Dim myCol As Long
Dim i As Long
Dim j As Long
t = Timer
On Error Resume Next
myFileName = "文本数据.txt"
Kill ThisWorkbook.Path & "" & myFileName
With Sheets(1)
myRow = .Cells(.Columns(1).Rows.Count, 1).End(xlUp).Row
myCol = .Cells(1, .Rows(1).Columns.Count).End(xlToLeft).Column
myDataAr = .Range(.Cells(1, 1), .Cells(myRow, myCol))
Open ThisWorkbook.Path & "" & myFileName For Output As #1
For i = 1 To UBound(myDataAr, 1)
myStr = ""
For j = 1 To UBound(myDataAr, 2)
myStr = myStr & CStr(myDataAr(i, j)) & " "
Next
myStr = Left(myStr, (Len(myStr) - 1))
Print #1, myStr
Next
Close #1
End With
MsgBox Format(Timer - t, "0.000")
End Sub
Sub FillData()
Sheets(1).[A1:J100000].Value = Rnd()
End Sub

复制代码

你试试这段，我电脑上速度是1.973秒。

爱疯 · 发表于 2013-12-10 11:41

轩辕轼轲发表于 2013-12-10 11:38
你试试这段，我电脑上速度是1.973秒。

谢谢重新修改了!

这问题主要是为学习哪种办法更快？也许差不了多少
所以，暂时先不急

		自动登录	找回密码
密码			注册

怎样更快将数组导出为文本

评分

评分