Printable View
Hello ,
i need a help .
i have two csv files
the first csv file contains a table , each column seperates with ;
the second csv file contains a table ,each column seperates with ,
i would like to have a macro vba script to let user to enter the input file path of csv and also choose the output folder path then click on button to run the script and get the output file
my files :
https://www.mediafire.com/folder/wyj8nir5mbb5p/data
Attachment 31784Attachment 31785Attachment 31786
Welcome to VBAX Soly_90. Did you by any chance post this issue elsewhere?
I have asked in somewhere else but I did not get the solution .so I have asked here ,if someone could solve my issue ?
Hi Soly_90,
Can I recommend that you read the 'What is multiposting' of the below link:
http://www.vbaexpress.com/forum/faq...._new_faq_item3
It is a rule of most (if not all) Excel forums that if you post the same question on more than one forum, you should post a link to the other forums. The below link will explain why you should do this in more detail:
https://excelguru.ca/a-message-to-forum-cross-posters/
Advise you zip files with Windows Compression and attach to post.
Maybe this could work
Code:Sub MergeCSVs()
Dim FilePath1 As String
Dim FilePath2 As String
Dim DestSheet As Worksheet
Dim FSO As Object
' FileSystemObject
Dim TextStream1 As Object
' TextStream for first file
Dim TextStream2 As Object
' TextStream for second file
Dim DataArray1 As Variant
Dim DataArray2 As Variant
Dim RowCounter As Long
Dim ColCounter As Long
Dim OutputRow As Long
' Get the file paths from the user
FilePath1 = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv), *.csv", Title:="Select the first CSV file (semicolon delimited)")
If FilePath1 = False Then Exit Sub
' User cancelled FilePath2 = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv), *.csv", Title:="Select the second CSV file (comma delimited)")
If FilePath2 = False Then Exit Sub
' User cancelled
' Set the destination sheet (you can change this if needed)
Set DestSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
DestSheet.Name = "MergedData"
OutputRow = 1
' Create FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
' Process the first CSV file (semicolon delimited)
On Error Resume Next
' In case the file doesn't exist
Set TextStream1 = FSO.OpenTextFile(FilePath1, 1)
' ForReading
On Error GoTo 0
If Not TextStream1 Is Nothing Then
Do Until TextStream1.AtEndOfStream
DataArray1 = Split(TextStream1.ReadLine, ";")
For ColCounter = LBound(DataArray1) To UBound(DataArray1)
DestSheet.Cells(OutputRow, ColCounter + 1).Value = Trim(DataArray1(ColCounter))
' Trim to remove extra spaces
Next ColCounter
OutputRow = OutputRow + 1
Loop
TextStream1.Close
Else
MsgBox "Could not open the first CSV file.", vbExclamation
End If
' Process the second CSV file (comma delimited)
On Error Resume Next
' In case the file doesn't exist
Set TextStream2 = FSO.OpenTextFile(FilePath2, 1)
' ForReading
On Error GoTo 0
If Not TextStream2 Is Nothing Then
Do Until TextStream2.AtEndOfStream
DataArray2 = Split(TextStream2.ReadLine, ",")
For ColCounter = LBound(DataArray2) To UBound(DataArray2)
DestSheet.Cells(OutputRow, ColCounter + 1).Value = Trim(DataArray2(ColCounter))
' Trim to remove extra spaces
Next ColCounter
OutputRow = OutputRow + 1
Loop
TextStream2.Close
Else
MsgBox "Could not open the second CSV file.", vbExclamation
End If
' Clean up the FileSystemObject
Set TextStream1 = Nothing
Set TextStream2 = Nothing
Set FSO = Nothing
MsgBox "CSV files merged successfully into sheet '" & DestSheet.Name & "'.", vbInformation
End Sub
Assuming both csv files and the workbook are in the same folder.
Both csv files have header in the 1st row, should have nothing above the header.
Code:Sub test()
Dim myDir$, s$, cn As Object, rs As Object, i&
[a1].CurrentRegion.ClearContents
myDir = ThisWorkbook.Path
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.Ace.OLEDB.12.0"
.Properties("Extended Properties") = "Text;HDR=Yes;"
.Open myDir
End With
Set rs = CreateObject("ADODB.Recordset")
s = "Select A.Index, B.type, B.result As art, Null As `part`, Null As `full`, " & _
"Null As `end/type`, A.x, A.y, A.z From [Data.csv] A Left Join " & _
"[source.csv] B On A.target = B.target Where A.Index Is Not Null;"
rs.Open s, cn
With [a1]
For i = 0 To rs.Fields.Count - 1
.Offset(, i) = rs.Fields(i).Name
Next
.Cells(2, 1).CopyFromRecordset rs
.CurrentRegion.Offset(1).Columns("c").TextToColumns [c2], 1, Semicolon:=True
Columns("g:i").Replace ",", ".", 2
End With
Set rs = Nothing: Set cn = Nothing
End Sub
Thank you Jindon for your contribution
OOps, I missed...Quote:
Originally Posted by Soly_90
Code:Sub test2()
Dim fn$(1), x(1), y(1), i&, ii&, iii&, n&, temp$
For i = 0 To 1
fn(i) = Application.GetOpenFilename("CSVFiles,*.csv")
If fn(i) = "False" Then Exit Sub
Next
For i = 0 To 1
x(i) = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fn(i)).ReadAll, vbNewLine)
Next
For i = 0 To UBound(x(0))
If LCase$(x(0)(i)) Like "index;*" Then
For ii = i + 1 To UBound(x(0))
temp = Split(x(0)(ii), ";")(1)
For iii = 0 To UBound(x(1))
If Split(x(1)(iii), ",")(0) = temp Then
y(0) = Split(x(0)(ii), ";")
y(1) = Split(x(1)(iii), ",")
y(0)(1) = y(1)(1)
y(0)(1) = y(0)(1) & ";" & y(1)(2)
x(0)(n) = Join(y(0), ";"): n = n + 1
End If
Next
Next
End If
Next
With [a2].Resize(n)
.CurrentRegion.ClearContents
.Rows(0).Resize(, 9) = Array("index", "type", "art", "part", "full", "end/type", "x", "y", "z")
.Value = Application.Transpose(x(0))
.Columns(1).TextToColumns .Cells(1), 1, Semicolon:=True
.Columns("g:i").Replace ",", ".", 2
End With
End Sub