Microsoft 365 Macro de recherche

Zon à dit:

Salut ,

Si je comprends bien prenons la ligne 48 de ton fichier où tu n'as pas mis encore les resultats en K,L M et N.

Admettons c'est le 10 qui gagne , tu mets 10 en K48, et tu veux que toutes les cellules contenant 10 de la plage AD48:GK48 soient transformées en A ?? je mets 8 en L alors tous les 8 de la même plage soient en B ?


Peut être en formule là je passe ?? et en VBA c'est plus que faisable . Est ce que tu dois faire d'autre VBA d'ici peu ou c'est que pour ce fichier ???

Merci pour ton retour.
A+++

Cliquez pour agrandir...

VB:

'Zon V1  , à adapter
Const PlRang$ = "B3:C6"
Const PlFeuil$ = "E3:E10"
Const PlModif$ = "G3"
Const NomFParam$ = "Parametre"
Const Msg1$ = "Veuillez Vérifier le nom de la feuille parametre et le contenu de ses cellules"

Sub ExeRang()
   Application.Calculation = xlCalculationManual
   MajRang ActiveCell
   Application.Calculation = xlCalculationAutomatic
 
End Sub

Sub MajRang(C As Range) 'Gestion d'erreur à ajouter aprés tests
   Dim T, U, V, Ch, Numlig&
 
   Numlig = C.Row
  ' U = Init(ThisWorkbook.Name, NomFParam, PlFeuil)                     ' à voir pour le traitement de plusieurs feuilles à la fois, boucle sur U
   T = Init(ThisWorkbook.Name, NomFParam, PlRang)                       'recup de colonnes et des rangs
   Ch = T(LBound(T, 1), 1) & Numlig & ":" & T(UBound(T, 1), 1) & Numlig
   V = Init(ThisWorkbook.Name, ActiveSheet.Name, Ch)                      'recup plage K:N nom de la feuille à traiter
   Ch = Init(ThisWorkbook.Name, NomFParam, PlModif)                        'doit retourner 1 seule cellule
   Ch = Left(Ch, 2) & Numlig & ":" & Right(Ch, 2) & Numlig                 'PLage AD : GK avec numéro de ligne
  'Traitement d'une seule plage AD:GK, si plusieurs faire une boucle sur Ch
   TraitementRang T, V, ThisWorkbook.Name, ActiveSheet.Name, Ch, Numlig
 
End Sub

Sub TraitementRang(T, V, C$, ByVal F$, ByVal P$, Numlig&)
'On sert de le colonne 2 de T pour affecter la valeur  cellule qu'on vient de comparer avec V
Dim I&, J&, K&
I = 1
   With Workbooks(C).Sheets(F).Range(P)
      For K = 1 To .Cells.Count
         If .Cells(I, K) <> "" Then
            For J = LBound(V, 2) To UBound(V, 2)
               .Cells(I, K) = IIf(.Cells(I, K) = V(1, J), T(J, 2), .Cells(I, K))
            Next J
         End If
      Next K
   End With
End Sub

Function Init(ByVal C$, ByVal F$, ByVal P$)
  On Error Resume Next
   With Workbooks(C).Sheets(F).Range(P)
      Init = .Cells
   End With
End Function

Cliquez pour agrandir...

• Faire une copie de la feuille course pour les tests…
• Dans la feuille de données Course, on remplis les cellules de K48 à N48 , on peut saisir qu’une cellule sur 4 ou 2 sur 4. Il est primordial de rester sur la ligne 48 peu importe la cellule, le programme travaille à partir de la feuille active et de la cellule active. Si on passe à la ligne 52 , il faut rester sur la ligne 52.
• Faire ALT+F8 au clavier lancer la macro (il y en a qu’une normalement) ExeRang. La plage AD 😀K est modifiée.

Zon à dit:

Salut,


Dans un 1er temps je te propose d'y aller au trot , puis de passer au galop si besoin ....

Modifier les valeurs d’un plage de cellules en fonction d’un critère de classement particulier.

Je ne mets pas de pièce jointe pour que tu mettes les mains dans le moteur. Si besoin demander de l'aide..
Je n'ai pas mis de gestion d'erreur du programme.


Créer un feuille Parametre où on mets ceci:
En colonne B on mets les lettres de colonne où tu mets tes arrivées, si tu devais en mettre 5 tu insères une colonne dans tes feuilles de courses, alors sous N , (B7) on mettra O et en C7 E . La Plage en G3 est à adapter selon besoin. Pour l'instant F3 ne sert à rien , pas besoin de changer le nom de la feuille. Ce serait en vue d'un traitement de plusieurs feuilles en même temps

Regarde la pièce jointe 1173675



On fait ALT +F11 pour accéder à VBE , Insertion Module .Dans le module1, on colle ceci :

• Faire une copie de la feuille course pour les tests…
• Dans la feuille de données Course, on remplis les cellules de K48 à N48 , on peut saisir qu’une cellule sur 4 ou 2 sur 4. Il est primordial de rester sur la ligne 48 peu importe la cellule, le programme travaille à partir de la feuille active et de la cellule active. Si on passe à la ligne 52 , il faut rester sur la ligne 52.
• Faire ALT+F8 au clavier lancer la macro (il y en a qu’une normalement) ExeRang. La plage AD 😀K est modifiée.

La macro pourra être déclenchée par la suite par un bouton , un clic droit , le ruban .(pub pour le fil de PascalToulon Ruban pour vos programmes )



Le Galop serait de traiter plusieurs lignes à la fois, mais si tu es l’utilisateur unique cela devrait suffire.

A+++

Le Kiki de Zon

Cliquez pour agrandir...

Langrand à dit:

J'ai isolé la feuille cours "D" pour la démo mais en fait elle se trouve dans un fichier qui contient 6 feuilles.
Merci pour ton retour.
J.L. L.

Cliquez pour agrandir...

Zon à dit:

Si les 6 feuilles sont structurées de manière différentes , il faudra adapter le code ....

Cliquez pour agrandir...

Langrand à dit:

Les 6 feuilles sont structurées de la même manière.

Là j'ai un autre message d'erreur qui concerne je cois la ligne en jaune Ch = T(LBound(T, 1), 1) & Numlig & ":" & T(UBound(T, 1), 1) & Numlig
avec le message: Erreur d'exécution '13' Incompatibilité de type

Cliquez pour agrandir...

Zon à dit:

Coquinou, tu as mis K en ligne 4 sur la feuille parametre.
et tu as effacé la partie de constantes en haut du module1 , quand je disais VB: , c'était juste les 3 caractères.

C'est pas grave, je te remets ton fichier corrigé

A+++

Cliquez pour agrandir...

Langrand à dit:

Evidemment, ça ne pouvait pas fonctionner.
Maintenant ça y est!
Pour l'adaptation et le bouton dans le ruban on verra demain. Pour ce soir Papy se fatigue. Merci beaucoup en tout cas


J.L. L.

Cliquez pour agrandir...

Zon à dit:

Salut ,

Essaies de faire ton fichier avec le boutons persos que tu aimerais dans le ruban.

On adaptera si besoin la procédure ...

regardes l'appli de PatrickToulon avec les vidéos de formation. Ruban pour vos programmes

A+++

Cliquez pour agrandir...