I have a CSV with values with the format:123;456;789; for over 80k rows.
I want to import the data into an excel sheet, apply delimiter, format the data as a table and give the table a name.
I have tried parsing the data line by line, but I realised this is a very slow way to do it. It takes over 15 minutes to finish the process.
My original code below (directory is the location of CSV that I need to import, and only 1 file will be imported, so new solution doesn't need to take into account the case of several files):
Private Sub ReloadTable (directory As String, filter As String, tableRange As Range)
Dim file As Variant
Dim lines As Collection
Dim itemArray () As String
Dim newrow As ListRow
Dim i, j, progressStep As Integer
Application. DisplayStatusBar = TRUE
Application. ScreenUpdating = FALSE
Application. Calculation = xlCalculationManual
With tableRange.ListObject
If Not .DataBodyRange Is Nothing Then
.DataBodyRange.Delete
End If
For Each file In GetAllFiles (directory, filter)
Set lines = GetLinuxLine (directory & file)
progressStep-WorkshgetFunction.Max(1,WorksheetFunctio.Min(300, Int (lines.Count / 100) ))
For i =1 To lines.Count
If i Mod progressStep = 0 Then
Application. StatusBar = "Importing & directory & file & " (" & CStr (i) & "/m & CStr (lines. Count) & ") "
DoEvents
End If
itemArray = Split (lines.Item (i),"; ",-1,vbTextCompare)
Set newrow = ListRows.Add
With newrow
For j = 1 To .Range.Count
.Range (j) = itemArray (j - 1)
Next j
End With
Next i
Next file
End With
Application. StatusBar= ""
Application. Calculation = xlCalculationAutomatic
Application. ScreenUpdating = TRUE
End Sub
My thought on improving this code is that, instead of performing operation line by line, I plan to:
- Apply delimiter on the CSV & open a worksheet of the CSV with delimiter applied
- Copy all data
- Paste them in the destination worksheet
- Format it as a table and name it as "tCSV"
I made some code to try it out, but seems like I failed to apply delimiter (as the wb result does not have delimiter applied):
csv_file= "S:\aaaa\ABC.csv"
Set wb = Workbooks. Open (csv_file, Format: =6, Delimiter:=";")
tt = wb, Sheets (1) . Range ("A1") .Value
MsgBox tt
Any help would be greatly appreciated, thanks in advance.
CodePudding user response：
if you are on excel newer than 2010* the above scenario is a good reason to learn powerquery (get and transform) instead of VBA. It does exactly what you want to happen and it does so multithreaded by default.
to fix the performance of you code as is, i would recommend batching your write operations to the sheet, i.e instead of doing
With newrow For j = 1 To .Range.Count .Range (j) = itemArray (j - 1) Next jdo something like
dim out(1 to 100, 1 to 256) as variant #or whatever number of columns you expect to have
[loop through 100 rows of your file and split them into the out array]
sheet.range(sheet.cell(startrow, 1), sheet.cell(startrow 100, 256).value=out
to get excel to open and parse a csv file with correct delimiter use Workbooks.OpenText instead of Workbooks.Open
*https://www.myonlinetraininghub.com/power-query-version-compatibility-and-installation
CodePudding user response：
CSV To New Excel Table (ListObjbect)
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the values from a CSV file in a new table
' in a worksheet of the workbook containing this code.
' Calls: TextFileToArray
' GetSplitArray
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ImportCSV()
Const ProcName As String = "ImportCSV"
On Error GoTo ClearError
Const SRC_FILE_PATH As String = "C:\Test\T2022\74951448\Test.csv"
Const DST_WORKSHEET_NAME As String = "Sheet1"
Const DST_FIRST_CELL As String = "A1"
Const DST_TABLE_NAME As String = "tCSV"
Dim sArr As Variant: sArr = TextFileToArray(SRC_FILE_PATH, vbCrLf)
If IsEmpty(sArr) Then Exit Sub
Dim dData As Variant: dData = GetSplitArray(sArr, ";")
If IsEmpty(dData) Then Exit Sub
Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
Dim dws As Worksheet: Set dws = dwb.Sheets(DST_WORKSHEET_NAME)
Dim dfcell As Range: Set dfcell = dws.Range(DST_FIRST_CELL)
Dim drg As Range
Set drg = dfcell.Resize(UBound(dData, 1), UBound(dData, 2))
Application.ScreenUpdating = False
drg.Value = dData
dws.ListObjects.Add(xlSrcRange, drg, , xlYes).Name = DST_TABLE_NAME
drg.Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "CSV file imported.", vbInformation
ProcExit:
Exit Sub
ClearError:
Debug.Print "@" & ProcName & "@ Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the split substrings of each element of a 1D array
' in columns of a row of a 2D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetSplitArray( _
ByVal SourceArray As Variant, _
Optional Delimiter As String = ",") _
As Variant
Const ProcName As String = "GetSplitArray"
On Error GoTo ClearError
Dim cLB As Long: cLB = LBound(SourceArray)
Dim cUB As Long: cUB = UBound(SourceArray)
Dim drCount As Long: drCount = cUB - cLB 1
If drCount = 0 Then Exit Function
Dim nArr() As String, nUB As Long, n As Long, c As Long
Dim Data() As Variant, dr As Long, dcCount As Long
For c = cLB To cUB
dr = dr 1
nArr = Split(SourceArray(c), Delimiter)
nUB = UBound(nArr)
If c = cLB Then ' first
dcCount = nUB 1
ReDim Data(1 To drCount, 1 To dcCount)
Else ' all but first
If nUB >= dcCount Then
dcCount = nUB 1
ReDim Preserve Data(1 To drCount, 1 To dcCount)
End If
End If
For n = 0 To nUB
Data(dr, n 1) = nArr(n)
Next n
Next c
GetSplitArray = Data
ProcExit:
Exit Function
ClearError:
Debug.Print "@" & ProcName & "@ Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns each line of a text file in an element
' of a 1D zero-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function TextFileToArray( _
ByVal FilePath As String, _
Optional LineSeparator As String = vbLf) _
As Variant
Const ProcName As String = "TextFileToArray"
On Error GoTo ClearError
Dim TextFile As Long: TextFile = FreeFile
Dim sArr() As String
Open FilePath For Input Access Read As TextFile
On Error Resume Next
sArr = Split(Input(LOF(TextFile), TextFile), LineSeparator)
On Error GoTo ClearError
Close TextFile
Dim n As Long
For n = UBound(sArr) To LBound(sArr) Step -1
If Len(sArr(n)) > 0 Then Exit For
Next n
If n < LBound(sArr) Then Exit Function
If n < UBound(sArr) Then ReDim Preserve sArr(0 To n)
TextFileToArray = sArr
ProcExit:
Exit Function
ClearError:
Debug.Print "@" & ProcName & "@ Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function