modification macro VBA

**1pim34** · 26/06/2023, 11h23

Bonjour à tous,

j'ai une macro qui fonctionne comme il faut dans un cadre précis.
Je souhaiterai savoir s'il est possible d'élargir ce cadre un petit peu.

mon fichier macro : PRADEAU2.xlsm

Le fichier source dont le contenu doit être collé en feuil1 du fichier précédant : source.xlsx

Dans ce fichier, j'ai le mois et l'année des écritures qui suivent en E3, la macro est faite de façon a créer les dates en associant le jour (colonne A) et le mois et l'année (cellule E2)

Je souhaiterai savoir si c'est possible de faire le même système avec ce fichier là : source2.xlsx

Dans ce fichier, le mois et l'année ne sont plus uniquement renseignés en E2 mais quelques part dans la colonne E et a plusieurs reprises.

Est ce qu'il est possible de créer comme le fait la macro actuelle, la liste des écritures avec les bonnes dates dans la feuille RESULTAT.

Je crois que c'est Philippe TULIEZ qui m'avait aidé pour cette première macro.

Merci d'avance.

**umfred** · 26/06/2023, 15h58

oui ça me semble totalement faisable.
Dans l'idée, parcourir la colonne E, si la cellule est une date, calculer la date à partir de la colonne A (Jour date= A, Mois Date et Année Date = Mois (E) et Année (E) comme fait actuellement, mais en changeant la référence de la cellule E2 par une référence "dynamique" changeant chaque fois que l'on rencontre une date.

Que veux faire des Totaux mensuels ?
Actuellement tu copies les données dans la Feuil1 puis tu appuis sur le bouton ? et la feuille PRADEAU sert de feuille de calcul ?
quelque chose du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
For i = 1 to lastrow
    if isDate(ActiveSheet.Range("E" & i)) then 'si la cellule Ei est une date, 
        For j=i+1 to lastrow
            if activesheet.range("A" & j).value <> "" then 'et si la cellule A(i+1) est non vide
                 'on calcule la date que l'on met dans la cellule Aj
                 activesheet.range("A" & j).Value=DateSerial(year(activesheet.range("E" & i)),month(activesheet.range("E" & i)),activesheet.range("A"&j)))
            else 
                 Exit For 'si pas de valeur dans la cellule Aj, on sort de la boucle de création de la date actuelle
            end if
       Next j
       i=j 'on actualise l'indice i (on passe directement à la cellule E de la ligne suivant la fin de la zone
    End If
Next i

à voir à intégrer au code existant

**1pim34** · 26/06/2023, 16h04

Bonjour et merci pour ce retour.

En fait je me suis servi d'une 1ere macro pour mettre sous un format qui me convenait à l'origine dans la feuille RESULTAT.

Dans un second temps, j'ai eu une autre problématique et je me sert de la feuille résultat pour transformer le format dans un nouveau pour ensuite l'enregistrer dans un fichier txt.

il faut que je me penche sur comment l'intégrer.
Je reviens rapidement vers vous.

Merci encore.

**umfred** · 26/06/2023, 18h02

l'idéal serait de connaitre l'organisation des fichiers de départs et d'avoir l'aspect final et de faire la macro en conséquence plutôt que passer des étapes intermédiaires qui n'apportent pas forcément grand chose au besoin (sauf si tu veux avoir avoir une étape intermédiaire précise, mais pour mais ça rentrerai dans l'aspect final).

**1pim34** · 27/06/2023, 08h06

@umfred,

le résultat final doit être celui ci : Ecritures.txt

En considérant que le fichier d'origine est le fichier Source donné dans mon 1er message ici.

L'idée est d'obtenir la même chose avec le fichier Source2 de mon 1er message.

En gros, c'est une construction du fichier .txt séparateur "," final depuis le contenu du fichier source2.
il faut :
- que le libellé soit entre des "" (colonne E du fichier source)
- le séparateur décimal devienne des "." au lieu de la ","
- le format de date doit être sous le format JJMMAAAA (composé à partir du jour (colonne A du fichier source) et du mois et année cellule EX (colonne E du fichier source))
- supprimer les lignes Total chaque fois qu'il y en a
- modifier ce qu'il y a en cellule DX en 70 quand en EX il y a une date
- ajouter sur le fichier final une ligne d'entête : ###EBPPivotV1
- dans la colonne D, modifier les 401 en F et les 411 en C
- que chaque ligne du fichier texte à partir de la ligne 2 soit numérotée de 1 à X, X étant le nombre total de ligne. Et ce dans la colonne A du tableau final.

Je pense avoir repris tout ce qu'il faut. J'espère que je suis assez clair.

Merci d'avance.

**umfred** · 27/06/2023, 13h31

Tu es sûr que tu n'as pas besoin d'entêtes de noms de colonnes dans ton fichier final? (dire que la colonne 1 est un index, en 2 la date (JJMMAAAA), en 3, le journal, en 4 le compte, en 6 le libellé, en 7 la pièce, en 8 la somme et en 9, le type.
Dans ton fichier, il y a une colonne vide entre le compte et le libellé, et une colonne vide à la fin, les virgules délimitent des colonnes de données.
Y a-t-il vraiment une utilité à mettre les guillemets autour du libellé ?
Le séparateur décimal dépend en grande partie du celui défini sur Windows (chez moi, je le change directement dans mes options régionales).
Je vais essayer de regarder cet après-midi.
Mon code va se baser sur le code déjà fourni, je vais juste étoffer ce que je fais dans le if je pense (+ la création du fichier final)

**1pim34** · 27/06/2023, 13h35

Oui, il faut bien supprimer l'entête, les guillemets sur les libellés sont aussi important et toutes les colonnes sont nécessaires.

En gros ce fichier final répond aux besoins du logiciel pour lequel il est destiné.

Merci beaucoup.

**umfred** · 27/06/2023, 17h47

j'ai un doute pour la colonne "journal", c'est 70 tout le temps en fait ?

**umfred** · 27/06/2023, 18h26

voilà un 1er jet (en attendant une réponse pour journal)
Il faut copier les données dans l'onglet source et clic sur le bouton sur la feuille Accueil (les autres feuilles c'est une copie des données précédentes)
On créé directement le fichier Ecritures_01.txt dans un répertoire c:\Temp (à créer ou à modifier dans le code) (on peut changer le nom dans le code; on pourrait demander l'emplacement et le nom)
TraiterSource.xlsm

**1pim34** · 28/06/2023, 09h43

Envoyé par umfred

j'ai un doute pour la colonne "journal", c'est 70 tout le temps en fait ?

oui 70 partout.

**1pim34** · 28/06/2023, 09h58

Envoyé par umfred

voilà un 1er jet (en attendant une réponse pour journal)
Il faut copier les données dans l'onglet source et clic sur le bouton sur la feuille Accueil (les autres feuilles c'est une copie des données précédentes)
On créé directement le fichier Ecritures_01.txt dans un répertoire c:\Temp (à créer ou à modifier dans le code) (on peut changer le nom dans le code; on pourrait demander l'emplacement et le nom)
TraiterSource.xlsm

ça à l'air de fonctionner assez bien.

il semble juste que le radical des comptes commençants par 401 et 411 ne soient pas modifiés par F et C.

Je ne sais pas si tu peux modifier également, le fichier résultat de la macro contient une dernière ligne vide.

Ce n'est pas majeure, mais si on peut la supprimer, c'est nickel.

Merci @umfred

**Franc** · 28/06/2023, 10h12

Salut, il me semble que je t'avais résolu ce problème de ligne en trop dans une précédente discussion non ?

https://www.developpez.net/forums/d2...xt-separateur/

**1pim34** · 28/06/2023, 10h15

Envoyé par Franc

Salut, il me semble que je t'avais résolu ce problème de ligne en trop dans une précédente discussion non ?

https://www.developpez.net/forums/d2...xt-separateur/

oui, désolé, je t'avoue que je n'ai pas vu comment apporter la modification sur la macro que Umfred vient de proposer.

**umfred** · 28/06/2023, 12h50

Pour supprimer la dernière ligne, je change les 2 WriteLine en Write et sur la création de ligne j'ajoute au début vbNewLine => txtLigne = vbNewLine & cpt & Sep
J'avais pas fait attention pour l'histoire des comptes, mais tu dois pouvoir facilement le rajouter (à ma décharge, il n'y a pas de tels comptes dans les exemples que tu as montré (ah si je viens de voir dans le fichier PRADEAU2)
j'ai modifié la ligne txtLigne=ws.Cells(j, ColSourceNames.Compte).Value & Sep en

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
                     txtCompte = Trim(ws.Cells(j, ColSourceNames.Compte).Value)
                     Select Case Left(txtCompte, 3)
                        Case "401":
                            txtCompte = "F" & Right(txtCompte, Len(txtCompte) - 3)
                        Case "411":
                            txtCompte = "C" & Right(txtCompte, Len(txtCompte) - 3)
                    End Select
                     txtLigne = txtLigne & txtCompte & Sep

(en rajoutant la déclaration de txtCompte au début)

Code complet:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Option Explicit
Public Enum ColSourceNames
    Jour = 1
    Piece = 2
    Libelle_ecriture = 3
    Compte = 4
    Libelle = 5
    Date = 5
    Debit = 6
    Credit = 7
    [_First] = Jour
    [_Last] = Credit
End Enum
 
Public Const FinalFileFullName = "c:\temp\Ecritures_01.txt"
Public Const Sep = ","
 
Public Sub Traiter()
 
    Dim fso, txtStream
    Dim lastrow As Long, i As Long, j As Long
    Dim ws As Worksheet
    Dim cpt As Long
    Dim txtLigne As String
    Dim txtCompte As String
 
    'initiation du fichier de sortie
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txtStream = fso.CreateTextFile(FinalFileFullName, True)
    'écriture de l'entête
    txtStream.Write ("###EBPPivotV1")
 
    'lecture des données
    ' ici on va considérer que les données sont dans un onglet "source"
    'on pourrait proposer de charger le fichier et en copier les infos dans cet onglet "source"
    Set ws = ThisWorkbook.Worksheets("source")
    lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    cpt = 1
    For i = 1 To lastrow
        If IsDate(ws.Cells(i, ColSourceNames.Date)) Then 'si la cellule Ei est une date,
            For j = i + 1 To lastrow
                If ws.Cells(j, ColSourceNames.Jour).Value <> "" Then 'et si la cellule A(i+1) est non vide
                     'on calcule la date que l'on met dans la cellule Aj
                     txtLigne = vbNewLine & cpt & Sep
                     txtLigne = txtLigne & Format(ws.Cells(j, ColSourceNames.Jour), "00") & Format(Month(ws.Cells(i, ColSourceNames.Date)), "00") & Format(Year(ws.Cells(i, ColSourceNames.Date)), "00") & Sep
                     txtLigne = txtLigne & "70" & Sep
                     txtCompte = Trim(ws.Cells(j, ColSourceNames.Compte).Value)
                     Select Case Left(txtCompte, 3)
                        Case "401":
                            txtCompte = "F" & Right(txtCompte, Len(txtCompte) - 3)
                        Case "411":
                            txtCompte = "C" & Right(txtCompte, Len(txtCompte) - 3)
                    End Select
                     txtLigne = txtLigne & txtCompte & Sep
                     txtLigne = txtLigne & Sep
                     txtLigne = txtLigne & """" & ws.Cells(j, ColSourceNames.Libelle).Value & """" & Sep
                     txtLigne = txtLigne & ws.Cells(j, ColSourceNames.Piece).Value & Sep
                     If ws.Cells(j, ColSourceNames.Debit).Value <> 0 Then
                        'débit
                        txtLigne = txtLigne & Replace(Format(ws.Cells(j, ColSourceNames.Debit).Value, "0.00"), ",", ".") & Sep
                        txtLigne = txtLigne & "D" & Sep
                    Else
                        'crédit
                        txtLigne = txtLigne & Replace(Format(ws.Cells(j, ColSourceNames.Credit).Value, "0.00"), ",", ".") & Sep
                        txtLigne = txtLigne & "C" & Sep
                    End If
                    txtLigne = txtLigne & Sep
                    txtStream.Write (txtLigne)
                    cpt = cpt + 1
                Else
                    If ws.Cells(j, ColSourceNames.Date).Value <> "Report : " Then
                        Exit For 'si pas de valeur dans la cellule Aj, on sort de la boucle de création de la date actuelle
                    End If
                End If
           Next j
           i = j 'on actualise l'indice i (on passe directement à la cellule E de la ligne suivant la fin de la zone
        End If
    Next i
 
    txtStream.Close
    Set txtStream = Nothing
    Set fso = Nothing
    MsgBox "Traitement fini", vbInformation + vbOKOnly
End Sub

TraiterSource_v1.1.xlsm

**1pim34** · 29/06/2023, 12h34

@umfred,

je suis désolé mais le dernier fichier que tu m'as envoyé me créé un fichier avec uniquement l'entête :

###EBPPivotV1

J'ai mal compris un truc ou il y a un soucis ?

Merci d'avance.

**umfred** · 29/06/2023, 16h57

oups, en effet, il faut changer ActiveSheet par ws dans le if IsDate(...); je corrige dans le code posté dans mon message précédent. Je pensais l'avoir corrigé, j'ai du faire une mauvaise manip.
et le fichier TraiterSource_v1.1.xlsm

**1pim34** · 30/06/2023, 08h23

Ca m'a l'air super Umfred,

Merci beaucoup pour le temps que tu auras passé sur mon problème.

Juste une précision, on est d'accord que la page Source2 (2) ne sert a rien, je peux l'enlever sans que ça impacte le fonctionnement ?

Merci pour tout.

**1pim34** · 30/06/2023, 08h29

Je suis désolé, je me suis rendu compte que je t'ai dis n'importe quoi concernant les comptes en 401 ou 411

en fait c'est l'inverse qu'il faut faire... Quand le compte (colonne D) commence par F il faut le remplacer par 401 et si c'est un C par 411.

Est ce qu'il est possible de supprimer le contenu de la feuille Source, quand j'ai collé dans ma feuille source des données sur moins de lignes, évidement mon résultat n'est pas bon car c'est un mix des lignes que je vient de coller plus celles qui n'ont pas été écrasées par le copier coller.
Par sécurité, je pense que c'est mieux de supprimer le contenu de source après génération du fichier Ecritures.txt

Est ce possible aisément de le modifier ?

Merci d'avance.

**umfred** · 04/07/2023, 14h47

manuellement, tu cliques sur la case entre la ligne 1 et la colonne A (ou tu fais fais un Ctrl+A) pour tout sélectionner et tu supprimes (touche du même nom), ça ne devrait pas effacer le bouton.
en code Sheets("source").Cells.ClearContentspour le compte, il suffit d'adapter le bout de code à ton besoin:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
                     txtCompte = Trim(ws.Cells(j, ColSourceNames.Compte).Value)
                     Select Case Left(txtCompte, 1)
                        Case "F":
                            txtCompte = "401" ' si on doit remplacer tout le nom par "401"
                            'txtCompte = "401" & Right(txtCompte, Len(txtCompte) - 1) ' si il faut juste remplacer le "F" par "401"
                        Case "C":
                            txtCompte = "411" ' si on doit remplacer tout le nom du compte par "411"
                            'txtCompte = "411" & Right(txtCompte, Len(txtCompte) - 1) ' si il faut juste remplacer le "C" par "411"
                    End Select
                     txtLigne = txtLigne & txtCompte & Sep

**1pim34** · 04/07/2023, 15h01

Merci Umfred, j'avais trouvé comment faire au final.

Merci encore, cela fonction très bien.

Bonne continuation.

modification macro VBA

Macros et VBA Excel

Discussions similaires

Partager

Partager