Re : Code VBA pour ajout d'une date lorsqu'elle n'existe pas
en effet je m'en excuse :
une partie du code :
Private Sub LireLeFichierTexte(CheminFichiertxt As String)
'variable à ne pas accorder attention
Dim intFic As Integer
'variable qui contiendera une ligne entière
Dim strLigne As String
'pas d'importance
intFic = FreeFile
'ouverture du fichier
Open CheminFichiertxt For Input As intFic
'Variable qui contiendera le nombre de ligne insérée
Dim i As Integer
'elle est initialisée à 2 pour commencer l'ecriture dans la 2ieme ligne
i = 2
Dim j As Integer
j = 0
Dim k As Integer
k = 0
Dim TableauFinalParCompte(999, 2)
Dim TableauFinalParRubrique(999, 2)
'ReDim Preserve TableauFinalParCompte(0, 2)
'boucle pour lire le fichier txt ligne par ligne elle veut dire tant que je suis pas sur la dernière ligne 'End Of File'
While Not EOF(intFic)
'lire la ligne et la stocker dans strligne
Line Input #intFic, strLigne
' si la ligne commence par BA. , c'est la ligne qui contient nos données
If InStr(1, strLigne, "BA.") Then
'puisque la ligne contient beacoup d'info elle doit etre stockée dnas un tableau délimité par espace
Do While InStr(1, strLigne, " ") > 0
strLigne = Replace(strLigne, " ", " ")
Loop
Dim ligneEntiere As Variant
'Diviser la ligne séparée par tabulation
ligneEntiere = Split(strLigne, " ")
'variable qui contiendera le numéro de compte
Dim NumeroDeCompte As Variant
'Diviser la ligne séparée par .
NumeroDeCompte = Split(ligneEntiere(1), ".")
'ecriture du compte dans la cellule A2 , A3 , A4 et ainsi de suite
'ActiveWorkbook.ActiveSheet.range("A" & i).Value = NumeroDeCompte(1)
Dim SoldeDeFinApresVirgule As Variant
Dim SoldeDeFinAvantVirgule As Variant
Dim SoldeDeFin As Variant
If IsNumeric(ligneEntiere(4)) Then
SoldeDeFin = ligneEntiere(4)
Else
SoldeDeFin = ligneEntiere(5)
End If
Dim PosDerniereVirguleSolde As Integer
PosDerniereVirguleSolde = InStrRev(SoldeDeFin, ".")
If PosDerniereVirguleSolde = 0 Then
SoldeDeFin = SoldeDeFin
Else
SoldeDeFinApresVirgule = Mid(SoldeDeFin, PosDerniereVirguleSolde + 1, 2)
SoldeDeFinAvantVirgule = Mid(SoldeDeFin, 1, PosDerniereVirguleSolde - 1)
SoldeDeFinAvantVirgule = Replace(SoldeDeFinAvantVirgule, ",", "")
SoldeDeFinAvantVirgule = Replace(SoldeDeFinAvantVirgule, " ", "")
SoldeDeFin = SoldeDeFinAvantVirgule & "," & SoldeDeFinApresVirgule
End If
Dim MontantApresVirgule As Variant
Dim MontantAvantVirgule As Variant
Dim Montant As Variant
Montant = ligneEntiere(UBound(ligneEntiere))
Dim PosDerniereVirguleMontant As Integer
PosDerniereVirguleMontant = InStrRev(Montant, ".")
If PosDerniereVirguleMontant = 0 Then
Montant = Montant
Else
MontantApresVirgule = Mid(Montant, PosDerniereVirguleMontant + 1, 2)
MontantAvantVirgule = Mid(Montant, 1, PosDerniereVirguleMontant - 1)
MontantAvantVirgule = Replace(MontantAvantVirgule, ",", "")
MontantAvantVirgule = Replace(MontantAvantVirgule, " ", "")
Montant = MontantAvantVirgule & "," & MontantApresVirgule
End If
Dim Rubrique As String
Rubrique = Mid(NumeroDeCompte(1), 1, 4)
'ActiveWorkbook.ActiveSheet.range("B" & i).Value = CDbl(Montant)
If NumeroDeCompte(1) = TableauFinalParCompte(j, 0) Or TableauFinalParCompte(j, 0) = "" Then
TableauFinalParCompte(j, 0) = NumeroDeCompte(1)
TableauFinalParCompte(j, 1) = CDbl(TableauFinalParCompte(j, 1)) + CDbl(SoldeDeFin)
TableauFinalParCompte(j, 2) = CDbl(TableauFinalParCompte(j, 2)) + CDbl(Montant)
Else
j = j + 1
'ReDim Preserve TableauFinalParCompte(0 To j, 0 To 2)
TableauFinalParCompte(j, 0) = NumeroDeCompte(1)
TableauFinalParCompte(j, 1) = CDbl(SoldeDeFin)
TableauFinalParCompte(j, 2) = CDbl(Montant)
End If
If Rubrique = TableauFinalParRubrique(k, 0) Or TableauFinalParRubrique(k, 0) = "" Then
TableauFinalParRubrique(k, 0) = Rubrique
TableauFinalParRubrique(k, 1) = CDbl(TableauFinalParRubrique(k, 1)) + CDbl(SoldeDeFin)
TableauFinalParRubrique(k, 2) = CDbl(TableauFinalParRubrique(k, 2)) + CDbl(Montant)
Else
k = k + 1
'ReDim Preserve TableauFinalParCompte(0 To j, 0 To 2)
TableauFinalParRubrique(k, 0) = Rubrique
TableauFinalParRubrique(k, 1) = CDbl(SoldeDeFin)
TableauFinalParRubrique(k, 2) = CDbl(Montant)
End If
i = i + 1
End If
'pas d'importance
Me.Repaint
Wend
'fermeture du fichier
Close intFic
For Each F In Sheets
If UCase(F.Name) Like "BASE BALANCE" Then
F.Activate
Exit For
End If
Next F
Dim l As Integer
l = 1
For l = 5 To 702
Cells(1, l).Select
If CStr(Cells(1, l).Value) = CStr(DateImport.Text) Then
Exit For
End If
Next
If l >= 702 Then
'MsgBox "Date in trouvable"
writecolumn = "DateImport.Text"
Exit Sub
End If
Dim m As Integer
m = 0
For m = 2 To 999
Dim n As Integer
n = 0
For n = 0 To 999
If Trim(Cells(m, 4)) = TableauFinalParCompte(n, 0) Then
Cells(m, l) = TableauFinalParCompte(n, 2)
Cells(m, l + 1) = TableauFinalParCompte(n, 1)
Exit For
End If
Next
Next
MsgBox "fin"
Unload Me
End Sub
Merci beaucoup Pierrot
Je vais essayer de joindre le fichier ou une capture écran de la page
