返回列表 上一主題 發帖

[發問] 如何將超過65536筆以上的資料放入活頁簿(已解決^^)

巴克斯

帖子
32 
主題
9 
精華
0 
積分
122 
點名
0  
作業系統
WINXP 
軟體版本
Office XP 
閱讀權限
20 
性別
男 
註冊時間
2010-5-14 
最後登錄
2024-3-20 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-5-27 12:39 | 只看該作者

[發問] 如何將超過65536筆以上的資料放入活頁簿(已解決^^)

本帖最後由 巴克斯 於 2011-5-28 09:06 編輯

EX:
文字檔: test.txt (筆數會超過65536,總筆數:未知)

希望程式依序將65536筆資料放入各工作表
sheet1   1-65536筆
sheet2   65537-131072筆
sheet3   ...以此類推到最末筆

請教須如何做較快速?
收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2011-5-27 12:52 | 只看該作者
回復 1# 巴克斯
可否傳上筆數少於65536 的程式碼,來看看如何改.

TOP

oobird
　頭銜: 街友一族

超級版主Rank: 8Rank: 8

帖子
1572 
主題
16 
精華
2 
積分
1521 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
150 
性別
男 
註冊時間
2010-5-1 
最後登錄
2016-1-13 

論壇貢獻勳章
3#
發表於 2011-5-27 14:07 | 只看該作者
  1. Sub yy()

  3. '引用Microsoft Scripting Runtime

  5. Application.ScreenUpdating = False
  6.            
  7.     Dim fso As Scripting.FileSystemObject
  8.     Dim myTxt As Scripting.TextStream
  9.     Dim myfile As String, myname$
  10.     Dim i As Long, j%
  11.    
  12.     ActiveSheet.Cells.Clear
  13.     myfile = Application.GetOpenFilename("text files (*.txt),*.txt", , "記事本文件")  '選擇文件名
  14.     Set fso = New Scripting.FileSystemObject
  15.     Set myTxt = fso.OpenTextFile(Filename:=myfile, IOMode:=ForReading)
  16.     With myTxt
  17.         i = 1: j = 1: myname = "sheet" & j
  18.         Do Until .AtEndOfStream
  19.            Sheets(myname).Cells(i, 1) = .ReadLine
  20.                      
  21.                       i = i + 1
  22.            If i = 65530 Then
  23.                j = j + 1
  24.                If j > 3 Then
  25.                     Sheets.Add after:=Sheets(myname)
  26.                End If
  27.                myname = "sheet" & j
  28.                i = 1
  29.            End If
  30.         Loop
  31.         .Close
  32.     End With

  34. End Sub
複製代碼
沒文件可測試，你自己測試一下吧

TOP

巴克斯

帖子
32 
主題
9 
精華
0 
積分
122 
點名
0  
作業系統
WINXP 
軟體版本
Office XP 
閱讀權限
20 
性別
男 
註冊時間
2010-5-14 
最後登錄
2024-3-20 
4#
發表於 2011-5-28 06:06 | 只看該作者
本帖最後由 巴克斯 於 2011-5-28 09:03 編輯

謝謝版主回覆
執行後發生錯誤訊息
編譯錯誤: 使用者自訂型態尚未定義

偵錯為
    Dim fso As Scripting.FileSystemObject
   Dim myTxt As Scripting.TextStream

麻煩版主看看是否可修訂,謝謝

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2011-5-28 08:03 | 只看該作者
回復 4# 巴克斯
Sub yy()
'引用Microsoft Scripting Runtime



不引用Microsoft Scripting Runtime的寫法
  1. Sub Ex()
  2.     Dim MyString As String, i As Long, Sh As Integer, Ar
  3.     Open "d:\test\test.txt" For Input As #1    ' 開啟輸入檔。
  4.     i = 1
  5.     Sh = 1
  6.     ReDim Ar(1 To Rows.Count)
  7.     Do While Not EOF(1)              ' 檢查是否已到檔尾。
  8.         If i > Rows.Count Then       'Rows.Count為列的總數 2003版本->65536
  9.             Sheets(Sh).Range("a:a") = Application.Transpose(Ar)
  10.             ReDim Ar(1 To Rows.Count)
  11.             i = 1
  12.             Sh = Sh + 1
  13.             If Sh > Sheets.Count Then Sheets.Add after:=Sheets(Sheets.Count)
  14.         End If
  15.         Line Input #1, MyString      ' 將資料讀入變數中。
  16.         Ar(i) = MyString
  17.         i = i + 1
  18.     Loop
  19.     Sheets(Sh).Range("a:a") = Application.Transpose(Ar)
  20.     Close #1
  21. End Sub
複製代碼

TOP

巴克斯

帖子
32 
主題
9 
精華
0 
積分
122 
點名
0  
作業系統
WINXP 
軟體版本
Office XP 
閱讀權限
20 
性別
男 
註冊時間
2010-5-14 
最後登錄
2024-3-20 
6#
發表於 2011-5-28 09:05 | 只看該作者
謝謝兩位板主的幫忙
兩種方式都成功了
比我原來土法煉鋼快速很多
也學習到精簡的程式寫法
^^

TOP

        靜思自在 : 【行善要及時】行善要及時，功德要持續。如燒開水一般，未燒開之前千萬不要停熄火候，否則重來就太費事了。
返回列表 上一主題