Discussion :

[djebalves]

Bonjour à tous,

Cela fait quelques temps que j'essaye d'écrire un programme VBA me permettant de reporter un montant en fonction de sa spécificité dans une feuille Excel.

Je m'explique :
Les spécificités se trouvent en colonne B de la Feuil1 du fichier Excel. A chacune des spécificités, est affecté un montant. Ce montant se trouve en colonne G de la Feuil1.
La Feuil2 est un tableau de répartition des dépenses en fonction des spécificités de la Feuil1.
La spécificité est composé d’un nombre à huit chiffres
- Les 4 premiers chiffres désignent la ligne du tableau de la Feuil2 du fichier Excel. Pour retrouver la ligne, il faut comparer les 4 premiers chiffres de la spécificité en colonne B de la Feuil1 d'Excel avec la colonne A de la Feuil2 du même fichier d'Excel.
- Si le 5ème chiffre de la spécificité est un 1 et que le 7ème chiffre de la spécificité est un 1 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne C de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel
- Si le 5ème chiffre de la spécificité est un 1 et que le 7ème chiffre de la spécificité est un 2 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne D de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel
- Si le 5ème chiffre de la spécificité est un 2 ou un 4 et que le 6ème chiffre de la spécificité est un 1 et que le 7ème chiffre de la spécificité est un 1 et que le 8ème chiffre de la spécificité est un 1 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne G de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel
- Si le 5ème chiffre de la spécificité est un 2 ou un 4 et que le 6ème chiffre de la spécificité est un 1 et que le 7ème chiffre de la spécificité est un 1 et que le 8ème chiffre de la spécificité est un 2 ou un 4 ou un 8 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne H de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel
- Si le 5ème chiffre de la spécificité est un 2 ou un 4 et que le 6ème chiffre de la spécificité est un 1 et que le 7ème chiffre de la spécificité est un 2 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne I de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel
- Si le 5ème chiffre de la spécificité est un 2 ou un 4 et que le 6ème chiffre de la spécificité est un 2 et que le 8ème chiffre de la spécificité est un 2 ou un 4 ou un 8 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne F de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel
- Si le 5ème chiffre de la spécificité est un 2 ou un 4 et que le 6ème chiffre de la spécificité est un 2 et que le 8ème chiffre de la spécificité est un 1 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne E de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel
- Si le 5ème chiffre de la spécificité est un 3 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne J de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel

Voici un exemple : la spécificité en cellule B40 de la Feuil1 d'Excel est 59914111. Le montant affecté à cette spécificité est 255 000 € et se trouve en cellule G40. Le montant de 255 000 € sera reporter en cellule G139 de la Feuil2 d'Excel.

Classeur1.xlsm

Merci beaucoup au personne qui m'aideront et aux autres également

[Fab_de_chez_PERFORM]

Bonjour
dans votre exemple, tout en bas, vous parlez de B40 en Feuil1 puis G139 dans feuil2. Ce ne serait pas plutôt B39 et G138 ?

[djebalves]

Bonjour
dans votre exemple, tout en bas, vous parlez de B40 en Feuil1 puis G139 dans feuil2. Ce ne serait pas plutôt B39 et G138 ?

Bonjour,

Effectivement vous avez raison. Désolé pour cette erreur.

[Fab_de_chez_PERFORM]

Re
Pourriez vous SVP controler ce que j'ai mis en latéral Feuil1

Ce sont des formules pour réussir à identifier la cellule où reporter l'info.
Si j'ai bien compris seules les cellules avec montant en G sont à traiter (voir colonnes W et X)

Pourriez vous aussi controler la cellule W65 en feuil1. J'ai une correspondance en Feuil 2 en ligne 44 mais je n'ai pas de lettre de colonne déterminée par l'une de vos 8 conditions.

Si ce que j'ai fait semble OK, ce sera + facile de faire la macro

[djebalves]

Re
Pourriez vous SVP controler ce que j'ai mis en latéral Feuil1

Ce sont des formules pour réussir à identifier la cellule où reporter l'info.
Si j'ai bien compris seules les cellules avec montant en G sont à traiter (voir colonnes W et X)

Pourriez vous aussi contrôler la cellule W65 en feuil1. J'ai une correspondance en Feuil 2 en ligne 44 mais je n'ai pas de lettre de colonne déterminée par l'une de vos 8 conditions.

Si ce que j'ai fait semble OK, ce sera + facile de faire la macro

Tout d'abord, merci énormément pour cette aide !!
Ensuite, dans la feuil2, en colonne A nous avons les lignes budgétaire. Cependant, certaines lignes disposent que de 3 voir 2 chiffres. Pour que le montant s'affecte au bonne endroit il faut regarder la racine. Par exemple, lorsque la spécificité est 11112221, cette spécificité est rattaché à la ligne 20 de la feuil2. Le montant de 500 000 € sera mis en cellule I20 de la feuil 2.

De plus, seules les montants inscrits dans la colonne G doivent être reporter dans la feuil 2.

Enfin concernant la condition pour la cellule W65, il me semblait l'avoir écrit dans l'une des conditions :
Si le 5ème chiffre de la spécificité est un 2 ou un 4 et que le 6ème chiffre de la spécificité est un 1 et que le 7ème chiffre de la spécificité est un 1 et que le 8ème chiffre de la spécificité est un 1 alors il faut placer le montant qui se trouve en colonne G de la Feuil1 d'Excel en colonne G de la Feuil2 d'Excel en fonction des 4 premiers chiffres de la spécificité qui détermine la ligne sur la Feuil2 d'Excel.

Je vous remercie encore une fois pour le temps que vous m'accordez.

[Fab_de_chez_PERFORM]

Bonjour
voici un petit code VBA pour reporter les données comme demandé

Après j'ai noté une bizarrerie sur les codes 19922112 et 19924112 qui sont présents 2x chacun sur la feuille 1. Le problème c'est que la macro ne reportera finalement que le dernier en G43 de la feuille 2.

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
85
86
87
88
89
90
91
92
Sub Report_Montant()
 
's'il y a un montant dans la colonne G de la feuil1, le reporter suivant les consignes données
'voir feuille mémo répartition
 
Dim Nom_Feuille_1 As String
Dim Nom_Feuille_2 As String
Nom_Feuille_1 = "Feuil1" 'à ajuster au besoin
Nom_Feuille_2 = "Feuil2" 'à ajuster au besoin
 
Dim c As Range
For Each c In Sheets(Nom_Feuille_1).Range("G2:G" & Sheets(Nom_Feuille_1).Range("A" & Rows.Count).End(xlUp).Row)
 
 
    If c.Value > 0 And Right(Sheets(Nom_Feuille_1).Range("B" & c.Row), 4) <> "0000" Then 'pour chaque cellule de la colonne G en Feuil1, je vérifie si montant et si code ne termine pas par 0000
 
        'Je récup le code spécificité équivalent en B et le décompose
        Dim Spécificité As String
        Spécificité = Sheets(Nom_Feuille_1).Range("B" & c.Row)
 
        Dim Racine As String
        Racine = Left(Spécificité, 4)
 
        Dim Cinq As Integer
        Dim Six As Integer
        Dim Sept As Integer
        Dim Huit As Integer
 
        Cinq = Right(Left(Spécificité, 5), 1)
        Six = Right(Left(Spécificité, 6), 1)
        Sept = Right(Left(Spécificité, 7), 1)
        Huit = Right(Left(Spécificité, 8), 1)
 
            Dim Ma_Col As String
 
            'Cas 1 : 5=1 et 7=1 => Col. C
            If Application.And(Cinq = 1, Sept = 1) Then
            Ma_Col = "C"
            End If
 
             'Cas 2 : 5=1 et 7=2 => Col. D
            If Application.And(Cinq = 1, Sept = 2) Then
            Ma_Col = "D"
            End If
 
            'Cas 3 : 5=2 ou 4 et 6=1 et 7=1 et 8=1 => Col. G
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 1, Huit = 1) Then
            Ma_Col = "G"
            End If
 
            'Cas 4 : 5=2 ou 4 et 6=1 et 7=1 et 8= 2 ou 4 ou 8 => Col. H
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 1, Application.Or(Huit = 2, Huit = 4, Huit = 8)) Then
            Ma_Col = "H"
            End If
 
            'Cas 5 : 5=2 ou 4 et 6=1 et 7=2 => Col. i
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 2) Then
            Ma_Col = "i"
            End If
 
            'Cas 6 : 5=2 ou 4 et 6=2 et 8=1 => Col. E
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 2, Huit = 1) Then
            Ma_Col = "E"
            End If
 
            'Cas 7 : 5=2 ou 4 et 6=2 et 8= 2 ou 4 ou 8 => Col. F
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 2, Application.Or(Huit = 2, Huit = 4, Huit = 8)) Then
            Ma_Col = "F"
            End If
 
            'Cas 8 : 5=3 => Col. J
            If Cinq = 3 Then
            Ma_Col = "J"
            End If
 
    'report de l'info si la ligne existe
        Dim Ligne_Equiv_Feuil2 As String
            If WorksheetFunction.IfError(Application.Match(Racine, Sheets(Nom_Feuille_2).Range("A:A"), 0), "N EXISTE PAS") <> "N EXISTE PAS" Then
            Ligne_Equiv_Feuil2 = Application.Match(Racine, Sheets(Nom_Feuille_2).Range("A:A"), 0) 'ca me permet d'avoir la ligne equiv en feuille 2
                'j'ai déterminé la colonne et la ligne donc je reporte l'info en Feuille 2
                Sheets(Nom_Feuille_2).Range(Ma_Col & Ligne_Equiv_Feuil2).Formula = "=" & Sheets(Nom_Feuille_1).Name & "!" & c.Address 'c etant la cellule testée au départ
            Else
            MsgBox ("Le montant de " & c.Value & " € présent en G" & c.Row & " n'a pas été reporté car le code est absent en " & Nom_Feuille_2 & " => [ " & Sheets(Nom_Feuille_1).Range("C" & c.Row).Value & " ]"), , "Report de cette info annulé"
            End If
 
    End If
 
 
 
Next
 
End Sub

Je vous joins mon fichier test
djebalves.xlsm

Petite remarque constructive : Pour une éventuelle prochaine fois sur le forum, dans votre énoncé de départ, il aurait mieux valu mettre un petit schéma moins indigeste comme celui là :

[djebalves]

Merci beaucoup pour votre aide !!!

Je profite de votre gentillesse... pensez-vous qu'il soit possible que la macro ajoute les montants dans les bonnes cellules au lieu que la Macro prennent le dernier montant ?

Bonne journée à vous.

[Fab_de_chez_PERFORM]

Re
tant mieux si ca semble convenir

du coup pour votre remarque, ca serait possible oui mais il y a un mais
en faisant ce à quoi je pense, au lieu d'écrire un =adresse cellule, on dirait =contenu cellule + adresse cellule. Cela veut dire qui si vous lancez une seconde fois la macro, les montants seraient à minima doublés.
A moins qu'on efface d'abord en feuille 2 toutes les cellules où il est censé y avoir des info ?

après c'est votre utilisation qui permettrait d'y voir plus clair

[deedolith]

Si j'ai bien compris, et pour résuer, tu veux dispatcher des montants.

Ca doit être fesable par Power Query, encore faut-il définir les tables référentiel.
Question subsidiaire, je suppose que si plusieurs lignes ont une "spécificité" identique, on fait la somme ?

[djebalves]

Re
tant mieux si ca semble convenir

du coup pour votre remarque, ca serait possible oui mais il y a un mais
en faisant ce à quoi je pense, au lieu d'écrire un =adresse cellule, on dirait =contenu cellule + adresse cellule. Cela veut dire qui si vous lancez une seconde fois la macro, les montants seraient à minima doublés.
A moins qu'on efface d'abord en feuille 2 toutes les cellules où il est censé y avoir des info ?

après c'est votre utilisation qui permettrait d'y voir plus clair

Bonjour,

pour le fait d'effacer d'abord la feuille 2, je mettrais en place une formule dans le programme VBA pour sélectionner les cellules à effacer donc ne vous embêter pas avec cela.
Mais l'idéal, oui il faudrait que les montants s'ajoutent.

Merci encore.

[djebalves]

Si j'ai bien compris, et pour résuer, tu veux dispatcher des montants.

Ca doit être fesable par Power Query, encore faut-il définir les tables référentiel.
Question subsidiaire, je suppose que si plusieurs lignes ont une "spécificité" identique, on fait la somme ?

Bonjour,

Oui il faut faire la somme lorsque les spécificités sont identiques ou ont la même destination.
Non le but n'est pas de dispatcher les montants mais compléter les états d'un budget.

[Fab_de_chez_PERFORM]

Bonjour
désolé pour le temps de réponse
voici le code qui fait l'addition (sans suppression des infos en feuille 2 attention !!! -> voir ta réponse du 16/02/2023, 09h49)

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
85
86
87
88
89
90
91
92
Sub Report_Montant()

's'il y a un montant dans la colonne G de la feuil1, le reporter suivant les consignes données
'voir feuille mémo répartition

Dim Nom_Feuille_1 As String
Dim Nom_Feuille_2 As String
Nom_Feuille_1 = "Feuil1" 'à ajuster au besoin
Nom_Feuille_2 = "Feuil2" 'à ajuster au besoin

Dim c As Range
For Each c In Sheets(Nom_Feuille_1).Range("G2:G" & Sheets(Nom_Feuille_1).Range("A" & Rows.Count).End(xlUp).Row)


    If c.Value > 0 And Right(Sheets(Nom_Feuille_1).Range("B" & c.Row), 4) <> "0000" Then 'pour chaque cellule de la colonne G en Feuil1, je vérifie si montant et si code ne termine pas par 0000
    
        'Je récup le code spécificité équivalent en B et le décompose
        Dim Spécificité As String
        Spécificité = Sheets(Nom_Feuille_1).Range("B" & c.Row)
        
        Dim Racine As String
        Racine = Left(Spécificité, 4)
        
        Dim Cinq As Integer
        Dim Six As Integer
        Dim Sept As Integer
        Dim Huit As Integer
        
        Cinq = Right(Left(Spécificité, 5), 1)
        Six = Right(Left(Spécificité, 6), 1)
        Sept = Right(Left(Spécificité, 7), 1)
        Huit = Right(Left(Spécificité, 8), 1)
        
            Dim Ma_Col As String
        
            'Cas 1 : 5=1 et 7=1 => Col. C
            If Application.And(Cinq = 1, Sept = 1) Then
            Ma_Col = "C"
            End If
            
             'Cas 2 : 5=1 et 7=2 => Col. D
            If Application.And(Cinq = 1, Sept = 2) Then
            Ma_Col = "D"
            End If
            
            'Cas 3 : 5=2 ou 4 et 6=1 et 7=1 et 8=1 => Col. G
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 1, Huit = 1) Then
            Ma_Col = "G"
            End If

            'Cas 4 : 5=2 ou 4 et 6=1 et 7=1 et 8= 2 ou 4 ou 8 => Col. H
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 1, Application.Or(Huit = 2, Huit = 4, Huit = 8)) Then
            Ma_Col = "H"
            End If
            
            'Cas 5 : 5=2 ou 4 et 6=1 et 7=2 => Col. i
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 2) Then
            Ma_Col = "i"
            End If
            
            'Cas 6 : 5=2 ou 4 et 6=2 et 8=1 => Col. E
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 2, Huit = 1) Then
            Ma_Col = "E"
            End If
           
            'Cas 7 : 5=2 ou 4 et 6=2 et 8= 2 ou 4 ou 8 => Col. F
            If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 2, Application.Or(Huit = 2, Huit = 4, Huit = 8)) Then
            Ma_Col = "F"
            End If
            
            'Cas 8 : 5=3 => Col. J
            If Cinq = 3 Then
            Ma_Col = "J"
            End If
            
    'report de l'info si la ligne existe
        Dim Ligne_Equiv_Feuil2 As String
            If WorksheetFunction.IfError(Application.Match(Racine, Sheets(Nom_Feuille_2).Range("A:A"), 0), "N EXISTE PAS") <> "N EXISTE PAS" Then
            Ligne_Equiv_Feuil2 = Application.Match(Racine, Sheets(Nom_Feuille_2).Range("A:A"), 0) 'ca me permet d'avoir la ligne equiv en feuille 2
                'j'ai déterminé la colonne et la ligne donc je reporte l'info en Feuille 2
                Sheets(Nom_Feuille_2).Range(Ma_Col & Ligne_Equiv_Feuil2).Value = Sheets(Nom_Feuille_2).Range(Ma_Col & Ligne_Equiv_Feuil2).Value + Range(Sheets(Nom_Feuille_1).Name & "!" & c.Address).Value
            Else
            MsgBox ("Le montant de " & c.Value & " € présent en G" & c.Row & " n'a pas été reporté car le code est absent en " & Nom_Feuille_2 & " => [ " & Sheets(Nom_Feuille_1).Range("C" & c.Row).Value & " ]"), , "Report de cette info annulé"
            End If
            
    End If



Next

End Sub