Macro Excel 365

**Babaorum11** · 28/04/2023, 16h52

Bonjour,
J'ai un tableau Excel et je cherche une "macro".
Le tableau a +/- 160 colonnes et 2000 rangées.
Je souhaite que les valeurs de la colonne "L" (des nombres de 1 à20) se transforment automatiquement en lettre "A" dans les colonnes "AD:FI" dès qu'elles ont la même valeur;
C'est à dire quand L16=5 , tous les "5" des colonnes "AD:FI" deviennent "A" automatiquement.
De la même façon toutes les valeurs de la colonne "M" deviennent"B" et les valeurs de la colonne "N" deviennent "C3.
Je vous joins un morceau de tableau pour plus de compréhension.
Je vous remercie de votre réponse
Babaorum 11

**umfred** · 28/04/2023, 17h13

sauf erreur, si je traduit ta demande, l'algo recherché serait de ce genre:

Code :

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

1
2
3
4
5
6
 
pour ligne = 16 à dernière_ligne
   pour colonne = "AD" à dernière colonne
       si cellule(ligne, "L").value = cellule(ligne,colonne).value alors cellule(ligne,colonne).value = cellule(1,"L")
       si cellule(ligne, "M").value = cellule(ligne,colonne).value alors cellule(ligne,colonne).value = cellule(1,"M")
       si cellule(ligne, "N").value = cellule(ligne,colonne).value alors cellule(ligne,colonne).value = cellule(1,"N")

Reste à transformer ça en code si ça répond à la demande

**Babaorum11** · 28/04/2023, 17h32

Bonjour,
Je ne comprends pas tout de ton explication. Je souhaite que
si cellule(ligne, "L").value = cellule(ligne,colonne).value alors cellule(ligne,colonne).value = cellule(1,"L") devienne "A" dans la ligne
si cellule(ligne, "M").value = cellule(ligne,colonne).value alors cellule(ligne,colonne).value = cellule(1,"M") devienne "B" dans la ligne
si cellule(ligne, "N").value = cellule(ligne,colonne).value alors cellule(ligne,colonne).value = cellule(1,"N") devienne "C" dans la ligne

de façon à ne plus avoir à le changer manuellement.
Sinon je pense que ça y ressemble

**umfred** · 28/04/2023, 17h46

cellule(1,"L") fait référence dans mon algo à la cellule "L1" qui contient "A", de même que la cellule M1 contient B et C1 contient C (plutôt que mettre la valeur en dur, j'utilise la valeur de la cellule de "référence")

**Babaorum11** · 28/04/2023, 17h54

Re bonjour,

Alors, ça semble être ce que je recherche.
En fait il n'y a pas de mise en forme en excel qui me permette d'y arriver donc je me tourne vers VBA mais je n'y connais rien et avant que j'aie appris à l'utiliser de l'eau aura coulé sous les ponts. Si j'y arrive ( parce qu'à mon âge...); donc je me tourne vers les spécialistes;
Merci si tu peux me concocter ça.
En fait je viens de voir ton mail dans ma boite , l'Hébreu à l'air plus facile.....

**Franc** · 28/04/2023, 18h00

Salut, testé et fonctionne.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub ChangeValues()
    Dim i As Long
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "L").End(xlUp).Row
    For i = 16 To lastRow
        Range("AD" & i & ":FI" & i).Replace What:=Cells(i, "L").Value, Replacement:=Cells(1, "L").Value, LookAt:=xlWhole
        Range("AD" & i & ":FI" & i).Replace What:=Cells(i, "M").Value, Replacement:=Cells(1, "M").Value, LookAt:=xlWhole
        Range("AD" & i & ":FI" & i).Replace What:=Cells(i, "N").Value, Replacement:=Cells(1, "N").Value, LookAt:=xlWhole
    Next i
 
    MsgBox "Traitement terminé !"
 
End Sub

**Babaorum11** · 28/04/2023, 18h14

ha ben ça alors! Vite fait bien fait!
Merci beaucoup.
Par hasard existe-t-il un moyen pour que le changement se fasse directement sans avoir besoin de lancer l'exécution ?
En tout cas c'est chouette, je suis ravi
Baborum11

**Franc** · 28/04/2023, 18h54

Oui, tu peux mettre le code dans l'évènement Worksheet_Change et supprimer le msgbox pour éviter de devoir valider à chaque modif.

**Babaorum11** · 29/04/2023, 17h07

Bonjour,
Je n'ai plus eu le temps hier pour te remercier. Désolé.
Mais je ne suis pas au bout de mes peines. ce qui fonctionnait bien sur mon tableau d'exemple ne fonctionne plus sur mon tableau réel.
D'abord il a fallu plus de 20 mn pour éxécution, puis il m'a rempli la feuille de "A" et je reçois un message " Erreur de compilation End Sub attendu" (copie d'écran en pièce jointe).
Le tableau original est trop volumineux pour le mettre en pièce jointe.

**Valtrase** · 29/04/2023, 17h43

Salut le fil,
Pour l'erreur du dois supprimer la ligne Sub ChangeValues()
Pour les problèmes de temps ajoutes Application.EnableEvents
Donc dans le module de la feuille concernée tu sélectionnes la méthode

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
'...
'...
'...
End Sub

et tu la remplace par celle-là :

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
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Catch
    ' // Ceci va empecher Excel de reboucler sur cette procédure à chaque fois qu'un changement va être éffectué
    ' // Pour éviter les temps à rallonge...
    Application.EnableEvents = False
 
    Dim i As Long
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "L").End(xlUp).Row
    For i = 16 To lastRow
        Range("AD" & i & ":FI" & i).Replace What:=Cells(i, "L").Value, Replacement:=Cells(1, "L").Value, LookAt:=xlWhole
        Range("AD" & i & ":FI" & i).Replace What:=Cells(i, "M").Value, Replacement:=Cells(1, "M").Value, LookAt:=xlWhole
        Range("AD" & i & ":FI" & i).Replace What:=Cells(i, "N").Value, Replacement:=Cells(1, "N").Value, LookAt:=xlWhole
    Next i
 
Catch:
    If Err <> 0 Then MsgBox "Oups... nous avons rencontré l'erreur suivante " & Err.Number & " " & Err.Description & " Dans le module de la feuille"
    Application.EnableEvents = True
End Sub

**Babaorum11** · 29/04/2023, 18h37

Bonjour et Merci de s'intéresser à mon petit cas...
J'ai effacé l'ancien code et introduit le nouveau.
J'essaie d'exécuter et on me demande un nom de macro puis créer et je tourne en rond.
J"ai le sentiment de n'être pas doué pour les macros et pourtant je suis sur de ne pas être si loin pour que ça fonctionne...

**Franc** · 29/04/2023, 19h12

En fait, dès le départ tu as commis 2 erreurs.
D'abord tu as copié le code dans l'évènement _SelectionChange au lieu de _Change que je t'avais indiqué.
La différence c'est que le premier va se déclencher chaque fois que tu vas sélectionner une autre cellule tandis que le second se déclenche quand il y a une modification qui se produit. Ensuite tu as copié une sub dans une autre sub, ce qui donne:

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
Sub ChangeValues()
 
 le code...
 
end sub

alors qu'il faut faire

Code :

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

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
 
le code...
 
end sub

Ensuite, tu ne dois rien exécuter, le code s'exécute automatiquement chaque fois que tu fais une modif dans la feuille puisqu'il est dans Worksheet_Change.
Si ce n'est pas le comportement désiré, sois plus clair.

**Valtrase** · 29/04/2023, 19h42

Re,
Est-ce le changement des valeurs de cellules dans les colonne L, M, N qui doit déclencher le recalcul ?
Doit-on faire un traitement par ligne ou bien global, par exemple dans l'exemple la cellule L16 vaut 5 doit-on changer les valeurs AD16:FI16 ou bien AD16:FI32 ?

Voici le fichier avec la procédure de Franc modifiée :

**Babaorum11** · 29/04/2023, 19h49

Ça fonctionne mais le temps de saisie est très très long (plusieurs secondes à chaque cellule) et toutes les cellules vides de la ligne affichent un "B"

**Valtrase** · 29/04/2023, 19h56

Re,
Tu n'as pas répondu aux questions.
avec autant de lignes et de colonnes peut-être que le passage par des tableaux serait judicieux.
Il n'est peut-être pas obligatoire de faire le recalcul à chaque changement de cellule.

**Babaorum11** · 29/04/2023, 20h22

Je n'avais pas vu les questions...
C'est bien le changement des cellules L M et N qui déclenche les changements et le traitement se fait par ligne.
J'enregistre toutes mes différentes données sur le ligne 159 par exemple et lorsque j'introduis les valeurs L M et N alors ça doit changer sur AD 159:FI 159.
Voilà

**Franc** · 29/04/2023, 21h57

Teste ça, copie le code dans Worksheet_Change

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
    If Not Intersect(Target, Range("L16:N" & Rows.Count)) Is Nothing Then
        ' Récupère le numéro de ligne de la cellule modifiée
        Dim modifiedRow As Long
        modifiedRow = Target.Row
 
        'Vérifier quelle colonne a été modifiée et utiliser cette colonne pour les comparaisons
 
        Dim modifiedCol As Long
        modifiedCol = Target.Column
        If modifiedCol = 14 Then 'Colonne L
            Range("AD" & modifiedRow & ":FI" & modifiedRow).Replace What:=Cells(modifiedRow, modifiedCol).Value, Replacement:=Cells(1, modifiedCol).Value, LookAt:=xlWhole
        ElseIf modifiedCol = 13 Then 'Colonne M
            Range("AD" & modifiedRow & ":FI" & modifiedRow).Replace What:=Cells(modifiedRow, modifiedCol).Value, Replacement:=Cells(1, modifiedCol).Value, LookAt:=xlWhole
        ElseIf modifiedCol = 12 Then 'Colonne N
            Range("AD" & modifiedRow & ":FI" & modifiedRow).Replace What:=Cells(modifiedRow, modifiedCol).Value, Replacement:=Cells(1, modifiedCol).Value, LookAt:=xlWhole
        End If
 
    End If

Si j'ai bien compris, tu encodes d'abord AD à FI et ensuite cellules L,M et N de la même ligne. Donc j'ai modifié pour que le code ne s'exécute que quand tu entres des données dans une des 3 cellules et pas les 3 en même temps,
ce qui évite de remplir les cellules vides de la ligne par des lettres tant que le 3 cellules L,M et N ne sont remplies.

**Valtrase** · 30/04/2023, 00h40

Salut le fil,
Comme dis plus haut, on ne va travailler que sur la ligne en cours, Remplace le code dans le module de ta feuille par celui-ci

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
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Catch
    ' // Ceci va empecher Excel de reboucler sur cette procédure à chaque fois qu'un changement va être éffectué
    ' // Pour éviter les temps à rallonge...
    Application.EnableEvents = False
 
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "L").End(xlUp).Row
    If Not Intersect(Target, Range("L16:N" & lastRow)) Is Nothing Then
        Range("AD" & Target.Row & ":FI" & Target.Row).Replace What:=Target.Value, Replacement:=Cells(1, Target.Column).Value, LookAt:=xlWhole
    End If
 
Catch:
    If Err <> 0 Then MsgBox "Oups... nous avons rencontré l'erreur suivante " & Err.Number & " " & Err.Description & " Dans le module de la feuille"
    Application.EnableEvents = True
End Sub