VBA按行读取csv文件与分割合并

'2017年2月1日05:43:35
'16年想开发的最后一个Excel代码经过漫长的酝酿与研究终于编写完毕，解决了超过一百万行的csv文件Excel打不开的问题，自动分割为多个sheet，并且数字超过15位不会后面全是0。
'也可以用于平常打开csv文件，速度比直接打开快一倍，还可以用于指定行数分割，多文件合并，csv批量转Excel。
'
'顺道普及：csv文件就是用逗号分隔的数据表，有回车或逗号的文本还有长数字用两个"包围（连续两个表示"本身）
'xlsx文件大小约csv的50%，打开时间约csv的30%，xlsx压缩可能变大，csv压缩后不到10%。

Sub csv分割合并()
    selectfiles = Application.GetOpenFilename("," & "*.*", , "打开", , True) '选择文件
    If TypeName(selectfiles) = "Boolean" Then '若未选择则结束程序运行
        Exit Sub
    End If
    
    关闭功能
    st = Time
    
    spt = [A5]
    Ln = [B5]
    If spt = "" Then spt = ","
    If Not (Ln > 0) Then Ln = 1048576 '用Not是为了包括非数值
    
    Workbooks.Add
    li = 2
    
    For Each fp In selectfiles
        
        Set FileObj = CreateObject("Scripting.FileSystemObject")
        Set TextObj = FileObj.OpenTextFile(fp) '定义对象，不耗时
        
        If Not TextObj.AtEndOfLine Then '记录并写入第一个标题行
            TitleText = Split(TextObj.Readline, spt)
            [A1].Resize(1, UBound(TitleText)) = TitleText '在合并工作表时也只是替代第一行
        End If
        
        Do While Not TextObj.AtEndOfLine
            If li > Ln Then '达到一定值新建表
                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位以上数值会保留
            '用时：UBound()<变量<数字，用数组给区域赋值比循环快五六倍左右
            '原先有数值会增加一倍时间，跟直接打开相等
            li = li + 1
        Loop
    Next
    Debug.Print (Time - st) * 24 * 60 * 60
    开启功能
End Sub

Sub csv转xlsx()
    selectfiles = Application.GetOpenFilename("," & "*.*", , "打开", , True) '选择文件
    If TypeName(selectfiles) = "Boolean" Then '若未选择则结束程序运行
        Exit Sub
    End If
    
    关闭功能
    st = Time
    
    spt = [A5]
    Ln = 1048576
    If spt = "" Then spt = ","
    If Not (Ln > 0) Then Ln = 1048576 '用Not是为了包括非数值
    
    For Each fp In selectfiles
        
        Set FileObj = CreateObject("Scripting.FileSystemObject")
        Set TextObj = FileObj.OpenTextFile(fp) '定义对象，不耗时
        
        Workbooks.Add
        li = 2
        
        If Not TextObj.AtEndOfLine Then '记录并写入第一个标题行
            TitleText = Split(TextObj.Readline, spt)
            [A1].Resize(1, UBound(TitleText)) = TitleText '在合并工作表时也只是替代第一行
        End If
        
        Do While Not TextObj.AtEndOfLine
            If li > Ln Then '达到一定值新建表
                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位以上数值会保留
            '用时：UBound()<变量<数字，用数组给区域赋值比循环快五六倍左右
            '原先有数值会增加一倍时间，跟直接打开相等
            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 '若未选择则结束程序运行
        Exit Function
    End If
    关闭功能
    st = Time
    
    For i = 1 To UBound(selectfiles)
    Set wb = Workbooks.Open(selectfiles(i))
    wb.Close 0 '不保存关闭约1.4e-11s可忽略不计
    Next
    
    Debug.Print (Time - st) * 24 * 60 * 60
    开启功能
End Function

Sub 关闭功能() '关闭一些功能加快 VBA 宏的运行速度
'    On Error Resume Next '出错继续运行
'    Application.DisplayAlerts = False '禁用警告信息
'    Application.DisplayAlerts = True '启用警告信息
    Application.ScreenUpdating = False '禁用屏幕更新
    Application.DisplayStatusBar = False '禁用状态栏
    Application.Calculation = xlCalculationManual '切换到手动计算-4135，如果中途需要计算时用Calculate
    Application.EnableEvents = False '禁用事件
    ActiveSheet.DisplayPageBreaks = False '禁用本表分页符
End Sub

Sub 开启功能() '开启关闭的功能，调试中断可运行开启功能
    Application.ScreenUpdating = True '启用屏幕更新
    Application.DisplayStatusBar = True '启用状态栏
    Application.Calculation = xlCalculationAutomatic '切换到自动计算-4105
    Application.EnableEvents = True '启用事件
    'ActiveSheet.DisplayPageBreaks = displayPageBreaksState '启用本表分页符
End Sub