如何使用excel vba打开一个非常大的.dat文件

我有一些非常大的数据文件(.dat)(超过Excel允许的1,048,000行)。 我不能完全弄清楚试图使用的macros是什么问题(最初是为带有“,”分隔符的文本文件编写的,而不是带有制表符分隔符的.dat文件)。 macros的工作,但是它导致数据被编译成一列(例如应该是5列,现在1列,所有的数字作为长文本string)。 有没有更好的方法来打开一个非常大的.dat文件,将其分割并将其导入到单独的工作表中,同时使用制表符分隔符将数据保存在单独的列中?

Sub ImportBigFile() Dim N As Long Dim Lim As Long Dim SS() As String Dim S As String Dim R As Long Dim C As Long Dim WS As Worksheet Dim FNum As Integer Dim FName As String FName = "C:\Folder 1\Folder 2\File.dat" FNum = FreeFile With ActiveWorkbook.Worksheets Set WS = .Add(after:=.Item(.Count)) End With Lim = WS.Rows.Count Open FName For Input Access Read As #FNum R = 0 Do Until EOF(FNum) R = R + 1 Line Input #FNum, S SS = Split(S, "\t", -1) For C = LBound(SS) To UBound(SS) WS.Cells(R, C + 1).Value = SS(C) Next C If R = Lim Then With ActiveWorkbook.Worksheets Set WS = .Add(after:=.Item(.Count)) End With R = 0 End If Loop End Sub 

  SS = Split(S, "\t", -1) 

应该

  SS = Split(S, chr$(9), -1) 

假设你的选项卡是ascii

这解决了2个问题,并提高了性能

  1. 如前所述,分割中使用的分隔符(vbTab)
  2. 您打开input的文件,但从不closures它
  3. 使用数组转换为范围格式,然后在一个操作中将其放在范围内

使用的testing文件包含3,145,731行和5列(122 Mb)

  • your code: 3.9 min (231.755 sec)
  • this code: 1.1 Min ( 64.966 sec)

 Option Explicit Public Sub ImportBigFile2() Const fName = "C:\Folder 1\Folder 2\File.dat" Dim maxR As Long, maxC As Long, wsCount As Long, arr As Variant, rng As Variant Dim fNum As Long, fText As String, ws As Worksheet, ln As Variant, nextR As Long Dim i As Long, r As Long, c As Long, t As Double, ubArr As Long t = Timer: fNum = FreeFile: maxR = ThisWorkbook.Worksheets(1).Rows.Count Open fName For Input Access Read As #fNum fText = Input$(LOF(1), 1) Close #fNum arr = Split(fText, vbCrLf): ubArr = UBound(arr) maxC = UBound(Split(arr(0), vbTab)) + 1 wsCount = ubArr \ maxR + 1: nextR = 0 Application.ScreenUpdating = False With ThisWorkbook.Worksheets For i = 1 To wsCount Set ws = .Add(After:=.Item(.Count)) ReDim rng(1 To maxR, 1 To maxC) For r = 1 To maxR ln = Split(arr(nextR), vbTab) For c = 1 To UBound(ln) + 1 rng(r, c) = ln(c - 1) Next nextR = nextR + 1: If nextR > ubArr Then Exit For Next ws.Range(ws.Cells(1, 1), ws.Cells(maxR, maxC)) = rng Next End With Application.ScreenUpdating = True Debug.Print "Time: " & Format(Timer - t, "#,###.000") & " sec" 'Time: 64.966 sec End Sub 

之前(CSV文件)

CSV

高强