- 帖子
- 231
- 主題
- 55
- 精華
- 0
- 積分
- 293
- 點名
- 0
- 作業系統
- winxp
- 軟體版本
- office2003
- 閱讀權限
- 20
- 性別
- 男
- 來自
- KEELUNG
- 註冊時間
- 2010-7-24
- 最後登錄
- 2018-8-28
|
11#
發表於 2011-10-12 23:24
| 只看該作者
你好：
請先試試是否可行
Sub tt()
'請先設定引用Microsoft Scripting Runtime
Dim mFso As Scripting.FileSystemObject
Dim mTxt As Scripting.TextStream
Dim mStr As String
Dim mPath$, mFile$
Dim ar(), ar1(), ar2()
Dim s%, s1 As Long, s2 As Long, m%, m1%, i%, j%
Dim mSplit
mPath = "C:\Documents and Settings\mine\My Documents\"
mFile = "SAS檔轉TXT檔的結果.txt"
Set mFso = CreateObject("Scripting.FileSystemObject")
Set mTxt = mFso.OpenTextFile(Filename:=mPath & mFile, IOMode:=ForReading)
With mTxt
Do Until .AtEndOfStream
mStr = .ReadLine
mSplit = Split(mStr)
For s = 0 To UBound(mSplit)
ReDim Preserve ar(s)
ar(s) = mSplit(m)
m = m + 1
Next
ReDim Preserve ar1(s1)
ar1(s1) = ar
s1 = s1 + 1
m = 0
Erase ar
If s1 > 65536 Then
ReDim Preserve ar2(s2)
ar2(s2) = ar1
s2 = s2 + 1
Erase ar1
s1 = 0
End If
Loop
.Close
End With
Erase ar1
s1 = 0
m1 = Worksheets.Count
For i = m1 + 1 To s2
Worksheets.Add
Next
For s1 = 0 To UBound(ar2)
Worksheets(s1 + 1).Range("a1").Resize(65536, 24) = Application.Transpose(Application.Transpose(ar2(s1)))
Next
Set mTxt = Nothing
Set mFso = Nothing
End Sub |
|
發表於 2011-10-14 13:37
| 
發表於 2011-10-13 17:37
| 
