Option Explicit
Declare Function GetTickCount Lib "kernel32" () As Long
Sub Tst97()
Dim Fichier As Variant
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv" )
If Fichier <> False Then Lire97 Fichier
End Sub
Private Sub Lire97(ByVal NomFichier As String)
Dim chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Sep As String * 1
Dim Debut As Long, Fin As Long
Debut = GetTickCount
Sep = ";"
Cells.Clear
Application.ScreenUpdating = False
Close
NumFichier = FreeFile
iRow = 0
Open NomFichier For Input As #NumFichier
Do While Not EOF(NumFichier)
iCol = 1: iRow = iRow + 1
Line Input #NumFichier, chaine
Split97 Ar(), chaine, Sep
For i = LBound(Ar) To UBound(Ar)
Cells(iRow, iCol) = Ar(i)
iCol = iCol + 1
Next i
Loop
Close #NumFichier
Fin = GetTickCount
Application.StatusBar = Format((Fin - Debut) / 1000, "0.00" )
Application.ScreenUpdating = True
End Sub
Private Sub Split97(ByRef Ar() As String, ByVal s As String, ByVal sSep As String)
Dim Pos As Integer
Dim i As Long, j As Long
Erase Ar
i = 1: j = 0
Do While i < Len(s)
If Mid(s, i, 1) = sSep Then
ReDim Preserve Ar(j)
Pos = InStr(s, sSep)
Ar(j) = Left(s, Pos - 1)
s = Right(s, Len(s) - Pos)
j = j + 1: i = 0
End If
i = i + 1
Loop
ReDim Preserve Ar(j)
Ar(j) = s
End Sub
|