大家好，由於小弟最近在處理一份檔案，該檔案資料量相當大
欄位會超過Excel 2007的欄位上限1048576
於是小弟想到一種解決方式，流程是：
1.匯入檔案後
2.超過欄位上限的資料自動置於第二個工作表
3.若第二個工作表也放不下，再往第三個工作表放…
4.依此類推直到檔案全部匯入完畢
但苦於小弟VBA功力不足，所以想請板上的高手幫忙解答一下，感謝~~
我有在網路上搜到這些程式碼，實作後應該沒問題...
只是資料量真的太大，跑完要三小時= =+,目前也正在試著用access
有興趣的可以試試...
Sub LargeFileImport()
'Dimension Variables
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double
'Ask User for File's Name
FileName = InputBox("Please enter the Text File's name, e.g. test.txt")
'Check for no entry
If FileName = "" Then End
'Get Next Available File Handle Number
FileNum = FreeFile()
'Open Text File For Input
Open FileName For Input As #FileNum
'Turn Screen Updating Off
Application.ScreenUpdating = False
'Create A New WorkBook With One Worksheet In It
'Workbooks.Add template:=xlWorksheet
'Set The Counter to 1
Counter = 1
'Loop Until the End Of File Is Reached
Do While Seek(FileNum) <= LOF(FileNum)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
'Store One Line Of Text From File To Variable
Line Input #FileNum, ResultStr
'Store Variable Data Into Active Cell
'修改如下
'ActiveCell(1, 1).Value = Mid(ResultStr, 1, 3) '第一欄
'ActiveCell(1, 2).Value = Mid(ResultStr, 4, 8) '第二欄
'ActiveCell(1, 3).Value = Mid(ResultStr, 9, 11) '第三欄
ActiveCell(1, 1).Value = ResultStr '第一欄
'ActiveCell(1, 2).Value = Mid(ResultStr, 4, 8) '第二欄
'ActiveCell(1, 3).Value = Mid(ResultStr, 9, 11) '第三欄
'請依實際需求修正
'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 1048576 Then
'If On The Last Row Then Add A New Sheet
ActiveWorkbook.Sheets.Add
Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False
End Sub
內文搜尋
從 APP 打開
X