Sub Creer_fichiers_fournisseurs()
Dim datedeb As Date, datefin As Date, coldate%, chemin$, fournisseurs$, fichier$
Dim Source, n%, x%, tablo, ub&, i&, s, dat As Variant, code$, liste(), nn&, txt$, j&
datedeb = CDate("01/03/2024") 'à adapter
'datedeb = CDate("01/03/2022") 'pour récupérer toutes les dates
datefin = Date 'date du jour
coldate = 8 'numéro de colonne à adapter
chemin = ThisWorkbook.Path & "\"
fournisseurs = chemin & "Fournisseurs\"
If Dir(fournisseurs, vbDirectory) = "" Then MkDir fournisseurs 'crée le sous-dossier
fichier = Dir(fournisseurs & "*.csv")
'---vide le sous-dossier---
While fichier <> ""
Kill fournisseurs & fichier
fichier = Dir
Wend
'---création des fichierse---
Source = Array("famrem_sacha_Pour Test.txt", "hzn_sacha_Pour Test.txt") 'à adapter
For n = 0 To UBound(Source)
x = FreeFile
Open chemin & Source(n) For Input As #x 'ouverture en lecture séquentielle
tablo = Split(Input(LOF(x), #x), vbCrLf)
ub = UBound(tablo)
Close #x
tri tablo, 1, ub - 1 'tri préalable par Quick sort
For i = 1 To ub
s = Split(tablo(i), ";", coldate + 1)
If UBound(s) + 2 > coldate Then
dat = s(coldate - 1)
If IsDate(dat) Then
dat = CDate(dat)
If dat >= datedeb And dat <= datefin Then
code = s(0) 'code fournisseur
ReDim Preserve liste(nn)
liste(nn) = "F" & Format(n + 1, "00") & code
nn = nn + 1
fichier = fournisseurs & "F" & Format(n + 1, "00") & code & ".csv"
x = FreeFile
Open fichier For Output As #x 'ouverture en écriture séquentielle
Print #x, tablo(0) 'titres
Print #x, tablo(i)
txt = code & ";*"
For j = i + 1 To ub
If Not tablo(j) Like txt Then Exit For
s = Split(tablo(j), ";", coldate + 1)
If UBound(s) + 2 > coldate Then
dat = s(coldate - 1)
If IsDate(dat) Then dat = CDate(dat): If dat >= datedeb And dat <= datefin Then Print #x, tablo(j)
End If
Next j
Close #x
i = j - 1
End If
End If
End If
Next i, n
'---remplissage de la ComboBox---
If nn = 0 Then Exit Sub
With ActiveSheet.ComboBox1
.Activate
.Text = ""
.List = liste
.DropDown 'déroule la liste
End With
End Sub
Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub