'2017年2月1日05:43:35
'16年想開發(fā)的最后一個Excel代碼經(jīng)過漫長的醞釀與研究終于編寫完畢，解決了超過一百萬行的csv文件Excel打不開的問題，自動分割為多個sheet，并且數(shù)字超過15位不會后面全是0。
'也可以用于平常打開csv文件，速度比直接打開快一倍，還可以用于指定行數(shù)分割，多文件合并，csv批量轉(zhuǎn)Excel。
'
'順道普及：csv文件就是用逗號分隔的數(shù)據(jù)表，有回車或逗號的文本還有長數(shù)字用兩個"包圍（連續(xù)兩個表示"本身）
'xlsx文件大小約csv的50%，打開時間約csv的30%，xlsx壓縮可能變大，csv壓縮后不到10%。
Sub csv分割合并()
selectfiles = Application.GetOpenFilename("," & "*.*", , "打開", , True) '選擇文件
If TypeName(selectfiles) = "Boolean" Then '若未選擇則結(jié)束程序運(yùn)行
Exit Sub
End If
關(guān)閉功能
st = Time
spt = [A5]
Ln = [B5]
If spt = "" Then spt = ","
If Not (Ln > 0) Then Ln = 1048576 '用Not是為了包括非數(shù)值
Workbooks.Add
li = 2
For Each fp In selectfiles
Set FileObj = CreateObject("Scripting.FileSystemObject")
Set TextObj = FileObj.OpenTextFile(fp) '定義對象，不耗時
If Not TextObj.AtEndOfLine Then '記錄并寫入第一個標(biāo)題行
TitleText = Split(TextObj.Readline, spt)
[A1].Resize(1, UBound(TitleText)) = TitleText '在合并工作表時也只是替代第一行
End If
Do While Not TextObj.AtEndOfLine
If li > Ln Then '達(dá)到一定值新建表
Sheets.Add
[A1].Resize(1, UBound(TitleText)) = TitleText
li = 2
End If
Text = Split(TextObj.Readline, spt) '讀取行并分割
Cells(li, 1).Resize(1, UBound(Text)) = Text '測試15位以上數(shù)值會保留
'用時：UBound()<變量<數(shù)字，用數(shù)組給區(qū)域賦值比循環(huán)快五六倍左右
'原先有數(shù)值會增加一倍時間，跟直接打開相等
li = li + 1
Loop
Next
Debug.Print (Time - st) * 24 * 60 * 60
開啟功能
End Sub
Sub csv轉(zhuǎn)xlsx()
selectfiles = Application.GetOpenFilename("," & "*.*", , "打開", , True) '選擇文件
If TypeName(selectfiles) = "Boolean" Then '若未選擇則結(jié)束程序運(yùn)行
Exit Sub
End If
關(guān)閉功能
st = Time
spt = [A5]
Ln = 1048576
If spt = "" Then spt = ","
If Not (Ln > 0) Then Ln = 1048576 '用Not是為了包括非數(shù)值
For Each fp In selectfiles
Set FileObj = CreateObject("Scripting.FileSystemObject")
Set TextObj = FileObj.OpenTextFile(fp) '定義對象，不耗時
Workbooks.Add
li = 2
If Not TextObj.AtEndOfLine Then '記錄并寫入第一個標(biāo)題行
TitleText = Split(TextObj.Readline, spt)
[A1].Resize(1, UBound(TitleText)) = TitleText '在合并工作表時也只是替代第一行
End If
Do While Not TextObj.AtEndOfLine
If li > Ln Then '達(dá)到一定值新建表
Sheets.Add
[A1].Resize(1, UBound(TitleText)) = TitleText
li = 2
End If
Text = Split(TextObj.Readline, spt) '讀取行并分割
Cells(li, 1).Resize(1, UBound(Text)) = Text '測試15位以上數(shù)值會保留
'用時：UBound()<變量<數(shù)字，用數(shù)組給區(qū)域賦值比循環(huán)快五六倍左右
'原先有數(shù)值會增加一倍時間，跟直接打開相等
li = li + 1
Loop
Debug.Print (Time - st) * 24 * 60 * 60
ActiveWorkbook.SaveAs Left(fp, InStrRev(fp, ".") - 1) & ".xlsx" '保存需要一倍的時間
ActiveWorkbook.Close 0
Next
Debug.Print (Time - st) * 24 * 60 * 60
開啟功能
End Sub
Function 文件打開計時器()
selectfiles = Application.GetOpenFilename("," & "*.*", , "打開", , True) '選擇文件
If TypeName(selectfiles) = "Boolean" Then '若未選擇則結(jié)束程序運(yùn)行
Exit Function
End If
關(guān)閉功能
st = Time
For i = 1 To UBound(selectfiles)
Set wb = Workbooks.Open(selectfiles(i))
wb.Close 0 '不保存關(guān)閉約1.4e-11s可忽略不計
Next
Debug.Print (Time - st) * 24 * 60 * 60
開啟功能
End Function
Sub 關(guān)閉功能() '關(guān)閉一些功能加快 VBA 宏的運(yùn)行速度
' On Error Resume Next '出錯繼續(xù)運(yùn)行
' Application.DisplayAlerts = False '禁用警告信息
' Application.DisplayAlerts = True '啟用警告信息
Application.ScreenUpdating = False '禁用屏幕更新
Application.DisplayStatusBar = False '禁用狀態(tài)欄
Application.Calculation = xlCalculationManual '切換到手動計算-4135，如果中途需要計算時用Calculate
Application.EnableEvents = False '禁用事件
ActiveSheet.DisplayPageBreaks = False '禁用本表分頁符
End Sub
Sub 開啟功能() '開啟關(guān)閉的功能，調(diào)試中斷可運(yùn)行開啟功能
Application.ScreenUpdating = True '啟用屏幕更新
Application.DisplayStatusBar = True '啟用狀態(tài)欄
Application.Calculation = xlCalculationAutomatic '切換到自動計算-4105
Application.EnableEvents = True '啟用事件
'ActiveSheet.DisplayPageBreaks = displayPageBreaksState '啟用本表分頁符
End Sub
