Macro Excel 365

Version imprimable

28/04/2023, 15h52
Babaorum11

1 pièce(s) jointe(s)

Macro Excel 365

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

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

Code:

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

28/04/2023, 16h32
Babaorum11

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
28/04/2023, 16h46
umfred

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")
28/04/2023, 16h54
Babaorum11

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.....:lol:

Salut, testé et fonctionne.

Code:

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

28/04/2023, 17h14
Babaorum11

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
28/04/2023, 17h54
Franc

Oui, tu peux mettre le code dans l'évènement Worksheet_Change et supprimer le msgbox pour éviter de devoir valider à chaque modif.
29/04/2023, 16h07
Babaorum11

1 pièce(s) jointe(s)

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.

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:

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

et tu la remplace par celle-là :

Code:

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

29/04/2023, 17h37
Babaorum11

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...
29/04/2023, 18h12
Franc
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:

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:

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.;)
29/04/2023, 18h42
Valtrase

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 :
29/04/2023, 18h49
Babaorum11

Ç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" :oops:
29/04/2023, 18h56
Valtrase

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.
29/04/2023, 19h22
Babaorum11

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à

Teste ça, copie le code dans Worksheet_Change ;)

Code:

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.

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:

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

30/04/2023, 12h36
Babaorum11

Bingo! Ça y est!
Je vous remercie vraiment sincèrement.
Babaorum

:P :oops: :oops:
30/04/2023, 16h02
Valtrase

Content de t'avoir aider,
Si tu as trouvé une réponse pertinente un petit :plusser: est toujours le bienvenue sans oublier de marquer la discussion en résolue.

Bonne prog.