cool hit counter VBA reads csv files by line with split merge_Intefrankly

VBA reads csv files by line with split merge


'2017year2 month1 sun05:43:35 '16 The last one that I wanted to develop in the yearExcel The code has finally been written after a long gestation and research, Solved over a million lines ofcsv documentsExcel The problem of not opening, Automatically split into multiplesheet, And the numbers exceed15 The bits won't be all behind0。 ' It can also be used to open the usualcsv documents, Twice as fast as opening directly, It can also be used to specify the number of line splits, Multi-file merge,csv batch forward (mail)Excel。 ' ' by way of popularization:csv A file is a comma-separated data table, Text with carriage returns or commas and long numbers are represented by two" surrounds( Two consecutive representations" themselves) 'xlsx File size approx.csv of50%, Open time approx.csv of30%,xlsx Compression may become larger,csv Compressed less than10%。

Sub csv split and merge() selectfiles = Application.GetOpenFilename("," & ".", , " turn", , True) ' Select file If TypeName(selectfiles) = "Boolean" Then ' If not selected, ends program run Exit Sub End If

 Close function
st = Time

spt = [A5]
Ln = [B5]
If spt = "" Then spt = ","
If Not (Ln > 0) Then Ln = 1048576 ' usefulnessNot is intended to include non-numeric

Workbooks.Add
li = 2

For Each fp In selectfiles
    
    Set FileObj = CreateObject("Scripting.FileSystemObject")
    Set TextObj = FileObj.OpenTextFile(fp) ' Define object, not time-consuming
    
    If Not TextObj.AtEndOfLine Then ' Record and write the first header line
        TitleText = Split(TextObj.Readline, spt)
        [A1].Resize(1, UBound(TitleText)) = TitleText ' It also just replaces the first row when merging worksheets
    End If
    
    Do While Not TextObj.AtEndOfLine
        If li > Ln Then ' Reaching a certain value New Table
            Sheets.Add
            [A1].Resize(1, UBound(TitleText)) = TitleText
            li = 2
        End If
        Text = Split(TextObj.Readline, spt) ' Read the rows and split them
        Cells(li, 1).Resize(1, UBound(Text)) = Text ' test (machinery etc)15 Values above one bit will be retained
        ' time-consuming:UBound()< variable< digital, Using arrays to assign values to regions is about five or six times faster than loops
        ' Originally there were values that would double the time, Equivalent to opening directly
        li = li + 1
    Loop
Next
Debug.Print (Time - st) * 24 * 60 * 60
 Enabling Features

End Sub

Sub csv forward (mail)xlsx() selectfiles = Application.GetOpenFilename("," & ".", , " turn", , True) ' Select file If TypeName(selectfiles) = "Boolean" Then ' If not selected, ends program run Exit Sub End If

 Close function
st = Time

spt = [A5]
Ln = 1048576
If spt = "" Then spt = ","
If Not (Ln > 0) Then Ln = 1048576 ' usefulnessNot is intended to include non-numeric

For Each fp In selectfiles
    
    Set FileObj = CreateObject("Scripting.FileSystemObject")
    Set TextObj = FileObj.OpenTextFile(fp) ' Define object, not time-consuming
    
    Workbooks.Add
    li = 2
    
    If Not TextObj.AtEndOfLine Then ' Record and write the first header line
        TitleText = Split(TextObj.Readline, spt)
        [A1].Resize(1, UBound(TitleText)) = TitleText ' It also just replaces the first row when merging worksheets
    End If
    
    Do While Not TextObj.AtEndOfLine
        If li > Ln Then ' Reaching a certain value New Table
            Sheets.Add
            [A1].Resize(1, UBound(TitleText)) = TitleText
            li = 2
        End If
        Text = Split(TextObj.Readline, spt) ' Read the rows and split them
        Cells(li, 1).Resize(1, UBound(Text)) = Text ' test (machinery etc)15 Values above one bit will be retained
        ' time-consuming:UBound()< variable< digital, Using arrays to assign values to regions is about five or six times faster than loops
        ' Originally there were values that would double the time, Equivalent to opening directly
        li = li + 1
    Loop
    Debug.Print (Time - st) * 24 * 60 * 60
    ActiveWorkbook.SaveAs Left(fp, InStrRev(fp, ".") - 1) & ".xlsx" ' It takes twice as long to save
    ActiveWorkbook.Close 0
Next
Debug.Print (Time - st) * 24 * 60 * 60
 Enabling Features

End Sub

Function file-open-timer() selectfiles = Application.GetOpenFilename("," & ".", , " turn", , True) ' Select file If TypeName(selectfiles) = "Boolean" Then ' If not selected, ends program run Exit Function End If Close function st = Time

For i = 1 To UBound(selectfiles)
Set wb = Workbooks.Open(selectfiles(i))
wb.Close 0 ' No save off about1.4e-11s negligible
Next

Debug.Print (Time - st) * 24 * 60 * 60
 Enabling Features

End Function

Sub Close function() ' Turn off some functions to speed up VBA Macro running speed ' On Error Resume Next ' Error continues to run ' Application.DisplayAlerts = False ' Disable warning messages ' Application.DisplayAlerts = True ' Enable warning messages Application.ScreenUpdating = False ' Disable screen updates Application.DisplayStatusBar = False ' Disable the status bar Application.Calculation = xlCalculationManual ' Switching to manual calculation-4135, If you need to calculate midway through the process useCalculate Application.EnableEvents = False ' Disable events ActiveSheet.DisplayPageBreaks = False ' Disable pagination for this table End Sub

Sub Enabling Features() ' Functions to turn on and off, Debug interruptions can be run Enabling Features Application.ScreenUpdating = True ' Enable screen updates Application.DisplayStatusBar = True ' Enabling the status bar Application.Calculation = xlCalculationAutomatic ' Switching to automatic calculation-4105 Application.EnableEvents = True ' Enable events 'ActiveSheet.DisplayPageBreaks = displayPageBreaksState ' Enable pagination for this table End Sub


Recommended>>
1、What should I do if my phone data is deleted by mistake Mobile phone data recovery tips you have to learn
2、ISCA 2018 Express Trim and Compression is King no
3、Take a brainstorm that predicts the future and changes the world
4、Linux commands that should never be used
5、Disadvantage or no more Apples push for AI chips will give future iPhones a big boost

    已推荐到看一看 和朋友分享想法
    最多200字,当前共 发送

    已发送

    朋友将在看一看看到

    确定
    分享你的想法...
    取消

    分享想法到看一看

    确定
    最多200字,当前共

    发送中

    网络异常,请稍后重试

    微信扫一扫
    关注该公众号