'2017年2月1日05:43:35
'16年想開(kāi)發(fā)的最后一個(gè)Excel代碼經(jīng)過(guò)漫長(zhǎng)的醞釀與研究終于編寫(xiě)完畢，解決了超過(guò)一百萬(wàn)行的csv文件Excel打不開(kāi)的問(wèn)題缠借，自動(dòng)分割為多個(gè)sheet扰柠，并且數(shù)字超過(guò)15位不會(huì)后面全是0枫慷。
'也可以用于平常打開(kāi)csv文件膛腐，速度比直接打開(kāi)快一倍遗增，還可以用于指定行數(shù)分割，多文件合并，csv批量轉(zhuǎn)Excel似舵。
'
'順道普及：csv文件就是用逗號(hào)分隔的數(shù)據(jù)表脚猾，有回車或逗號(hào)的文本還有長(zhǎng)數(shù)字用兩個(gè)"包圍（連續(xù)兩個(gè)表示"本身）
'xlsx文件大小約csv的50%，打開(kāi)時(shí)間約csv的30%啄枕，xlsx壓縮可能變大婚陪，csv壓縮后不到10%族沃。
Sub csv分割合并()
selectfiles = Application.GetOpenFilename("," & "*.*", , "打開(kāi)", , 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) '定義對(duì)象频祝，不耗時(shí)
If Not TextObj.AtEndOfLine Then '記錄并寫(xiě)入第一個(gè)標(biāo)題行
TitleText = Split(TextObj.Readline, spt)
[A1].Resize(1, UBound(TitleText)) = TitleText '在合并工作表時(shí)也只是替代第一行
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 '測(cè)試15位以上數(shù)值會(huì)保留
'用時(shí)：UBound()<變量<數(shù)字，用數(shù)組給區(qū)域賦值比循環(huán)快五六倍左右
'原先有數(shù)值會(huì)增加一倍時(shí)間脆淹，跟直接打開(kāi)相等
li = li + 1
Loop
Next
Debug.Print (Time - st) * 24 * 60 * 60
開(kāi)啟功能
End Sub
Sub csv轉(zhuǎn)xlsx()
selectfiles = Application.GetOpenFilename("," & "*.*", , "打開(kāi)", , 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) '定義對(duì)象常空，不耗時(shí)
Workbooks.Add
li = 2
If Not TextObj.AtEndOfLine Then '記錄并寫(xiě)入第一個(gè)標(biāo)題行
TitleText = Split(TextObj.Readline, spt)
[A1].Resize(1, UBound(TitleText)) = TitleText '在合并工作表時(shí)也只是替代第一行
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 '測(cè)試15位以上數(shù)值會(huì)保留
'用時(shí)：UBound()<變量<數(shù)字，用數(shù)組給區(qū)域賦值比循環(huán)快五六倍左右
'原先有數(shù)值會(huì)增加一倍時(shí)間盖溺，跟直接打開(kāi)相等
li = li + 1
Loop
Debug.Print (Time - st) * 24 * 60 * 60
ActiveWorkbook.SaveAs Left(fp, InStrRev(fp, ".") - 1) & ".xlsx" '保存需要一倍的時(shí)間
ActiveWorkbook.Close 0
Next
Debug.Print (Time - st) * 24 * 60 * 60
開(kāi)啟功能
End Sub
Function 文件打開(kāi)計(jì)時(shí)器()
selectfiles = Application.GetOpenFilename("," & "*.*", , "打開(kāi)", , 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可忽略不計(jì)
Next
Debug.Print (Time - st) * 24 * 60 * 60
開(kāi)啟功能
End Function
Sub 關(guān)閉功能() '關(guān)閉一些功能加快 VBA 宏的運(yùn)行速度
' On Error Resume Next '出錯(cuò)繼續(xù)運(yùn)行
' Application.DisplayAlerts = False '禁用警告信息
' Application.DisplayAlerts = True '啟用警告信息
Application.ScreenUpdating = False '禁用屏幕更新
Application.DisplayStatusBar = False '禁用狀態(tài)欄
Application.Calculation = xlCalculationManual '切換到手動(dòng)計(jì)算-4135漓糙，如果中途需要計(jì)算時(shí)用Calculate
Application.EnableEvents = False '禁用事件
ActiveSheet.DisplayPageBreaks = False '禁用本表分頁(yè)符
End Sub
Sub 開(kāi)啟功能() '開(kāi)啟關(guān)閉的功能，調(diào)試中斷可運(yùn)行開(kāi)啟功能
Application.ScreenUpdating = True '啟用屏幕更新
Application.DisplayStatusBar = True '啟用狀態(tài)欄
Application.Calculation = xlCalculationAutomatic '切換到自動(dòng)計(jì)算-4105
Application.EnableEvents = True '啟用事件
'ActiveSheet.DisplayPageBreaks = displayPageBreaksState '啟用本表分頁(yè)符
End Sub
