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

---

作者: 巴克斯    時間: 2011-5-27 12:39     標題: 如何將超過65536筆以上的資料放入活頁簿(已解決^^)

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

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

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

請教須如何做較快速?

---

作者: GBKEE    時間: 2011-5-27 12:52

回復 1# 巴克斯
可否傳上筆數少於65536 的程式碼,來看看如何改.

---

作者: oobird    時間: 2011-5-27 14:07

1. Sub yy()
   
2. 
   
3. '引用Microsoft Scripting Runtime
   
4. 
   
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
    
33. 
    
34. End Sub

複製代碼

沒文件可測試，你自己測試一下吧

---

作者: 巴克斯    時間: 2011-5-28 06:06

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

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

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

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

---

作者: GBKEE    時間: 2011-5-28 08:03

回復 4# 巴克斯
Sub yy()
'引用Microsoft Scripting Runtime

[attach]6377[/attach]

不引用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
    

複製代碼

---

作者: 巴克斯    時間: 2011-5-28 09:05

謝謝兩位板主的幫忙
兩種方式都成功了
比我原來土法煉鋼快速很多
也學習到精簡的程式寫法
^^

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)