Boucle et recherche VBA Excel

Bonjour,

Pouvez-vous m'aider pour créer une macro sous Excel ?

1- je saisis un nombre (ex: 743),
2- je saisis un symbole (ex: # )
Excel va chercher dans la feuille 'BASE' le nombre (743) copie la ligne.
Excel va coller cette ligne dans une feuille 'modèle' en A2 et en B2 colle le symbole (#).

Excel revient à l'étape 1et 2
si j'ai fini ma saisi je clic sur 'annuler' et la feuille 'Modèle' apparait avec tous les codes et symboles que j'ai saisi auparavant.

pour INFO:

la feuille 'Base' contient environ 500 nombres en colonne A avec couleurs de fond cellule A correspondantes aux code DMC.

MERCI

Bonjour,

Je pense que c'est réalisable sans macro, mais sans voir le fichier il y a un risque de répondre à côté.

Déposé ici votre fichier (pas besoin de la base de données complète, juste quelques lignes et sans données confidentielles)

Cdlt

Bonjour,

Merci de votre aide:)

J'ai un autre petit problème que je n'arrive pas à résoudre.

Ci-joint fichier Excel

Ce que j'aimerais avoir c'est un regroupement de données saisie ...

J'ai une colonne de couleur avec son numéro soit 456 couleurs colonne A2:A457

Je lance la macro:

1- Saisir le Numéro de couleur (DMC) = ...... (je saisi '150' )

2- Saisir le symbole = ...... ( je saisi '[' )

La macro revient en 1 tant qu'on a pas cliqué sur annuler.

Le résultat de la macro pour cet exemple se trouve de F3 à F8 avec:

Le Titre(D1) que je saisi à chaque nouvelle recherche.

La couleur correspondante au N°,

le N°,

le symbole

--> Très important la largeur des colonnes = 6 et la hauteur de lignes=52 Bien respecter ces données

les colonnes C3 et D9 sont falcultatifs

Si possible, un message d'erreur si je n'ai pas saisi le Titre en D1.

Voilà et encore une fois Merci à vous tous pour ce que vous faites.

Geoffroy

Bonjour,

ceci:

Sub Couleur()
    Dim DerLig_A As Long, DerLig_F As Long, N°Couleur As Long
    Dim Symbole As Variant
    Dim Titre As String
    Application.ScreenUpdating = False
    DerLig_A = Range("A" & Rows.Count).End(xlUp).Row
    DerLig_F = Range("F" & Rows.Count).End(xlUp).Row
    Titre = Range("D1").Value
    N°_Couleur = InputBox("Selectionnez le N° de la couleur", "Couleur")
    Symbole = InputBox("Selectionnez le Symbole", "Symbole")
    With Sheets("DMC").Range("A1:A" & DerLig_A)
        Set C = .Find(N°_Couleur, lookat:=xlWhole)
        If Not C Is Nothing Then
            Cells(DerLig_F + 1, "F") = Titre & Chr(10) & N°_Couleur & Chr(10) & Symbole
            Cells(DerLig_F + 1, "F").Interior.Color = .Cells(C.Row, "A").Interior.Color
        End If
    End With
End Sub

et n'attendez pas 4 mois pour dire si ça vous convient.

CDlt

Bonjour,

Exactement ça

mais il manque la boucle pour pouvoir saisir plusieurs couleurs et symboles.

On arrête la macro en cliquant sur 'annuler'

et si le N° n'existe pas le signaler par une boite de dialogue .

Merci

Désolé de n'avoir pas répondu de suite, complètement oublié de vous répondre car je suis parti sur autre chose

Geoffroy

Bonjour,

Essayez ceci:

Option Compare Text

Sub Couleur()
    Dim DerLig_A As Long, DerLig_F As Long, N°Couleur As Long
    Dim Symbole As Variant
    Dim Titre As String
    DerLig_A = Range("A" & Rows.Count).End(xlUp).Row
    Titre = Range("D1").Value
Debut:
    N°_Couleur = InputBox("Selectionnez le N° de la couleur", "Couleur")
    If N°_Couleur = "" Then Exit Sub
    Symbole = InputBox("Selectionnez le Symbole", "Symbole")
    If Symbole = "" Then Exit Sub
    DerLig_F = Range("F" & Rows.Count).End(xlUp).Row
    With Sheets("DMC").Range("A1:A" & DerLig_A)
            Set C = .Find(N°_Couleur, lookat:=xlWhole)
            If Not C Is Nothing Then
                Cells(DerLig_F + 1, "F") = Titre & Chr(10) & N°_Couleur & Chr(10) & Symbole
                Cells(DerLig_F + 1, "F").Interior.Color = Cells(C.Row, "A").Interior.Color
            Else
                MsgBox "Couleur introuvable"
            End If
    End With
    GoTo Debut
End Sub

Cdlt

Bonjour et BRAVO

Vous êtes le meilleur car sans aucune erreur la macro fonctionne parfaitement.

Encore une fois mes félicitations pour ce travaille rapide et efficace.

Merci

et bon WE

@+

Re,

Juste une question:

Pourquoi avez ajouté cette ligne?

Option Compare Text

merci

A+

Cordialement

Pour que le code ne fasse pas de distinction entre les majuscules et les minuscules.

Ok et un grand merci

Pouvez-vous m'ajouter une petite ligne dans le code (je n'y arrive pas )

Voilà

Quand la macro arrive à F15 j'aimerais qu'elle passe à la colonne suivante c'est à dire en G2 à G15 puis H2 en H15 etc .

De façon à imprimer sur une seule feuille

Merci

A+

Cdlt

Ceci:

Option Compare Text

Sub Couleur()
    Dim DerLig_A As Long, DerLig_F As Long, N°Couleur As Long, DerCol As Long
    Dim Symbole As Variant
    Dim Titre As String
    DerLig_A = Range("A" & Rows.Count).End(xlUp).Row
    DerCol = Range("ZZ1").End(xlToLeft).Column
    If DerCol = 4 Then DerCol = 5
    Titre = Range("D1").Value
Debut:
    N°_Couleur = InputBox("Selectionnez le N° de la couleur", "Couleur")
    If N°_Couleur = "" Then Exit Sub
    Symbole = InputBox("Selectionnez le Symbole", "Symbole")
    If Symbole = "" Then Exit Sub
    DerLig_F = Range("F" & Rows.Count).End(xlUp).Row
    If DerLig_F = 15 Then
        DerLig_F = 2
        DerCol = DerCol + 1
    ElseIf DerLig_F = 1 Then
        DerLig_F = 2
    End If
    With Sheets("DMC").Range("A1:A" & DerLig_A)
            Set C = .Find(N°_Couleur, lookat:=xlWhole)
            If Not C Is Nothing Then
                Cells(DerLig_F + 1, DerCol + 1) = Titre & Chr(10) & N°_Couleur & Chr(10) & Symbole
                Cells(DerLig_F + 1, DerCol + 1).Interior.Color = Cells(C.Row, "A").Interior.Color
            Else
                MsgBox "Couleur introuvable"
            End If
    End With
    GoTo Debut
End Sub

merci

La macro démarre en G3 et reste sur cette cellule

A+

Effacez les cellules E1 à H1 et relancez la macro

Ok ça fonctionne au 15 premiers de F3 à F15

puis la macro passe en G3 mais ne continue pas en dessous va en H3,I3 , J3 etc

merci

J'ai pu la faire fonctionner en insérant une colonne en F

j'ai juste modifié ceci

If DerLig_F = 15 Then
Call insereUnecol ----> insère une colonne 
DerLig_F = 2
'DerCol = DerCol + 1 ---ligne supprimée
ElseIf DerLig_F = 1 Then
DerLig_F = 2

ça fonctionne mais je ne sais pas si c'est bon :)

merci

Bonsoir,

2 questions:

1-Est-il possible , en automatique, d'avoir la couleur du texte différent du fond de la cellule, afin de pouvoir le lire ?

2- Peut-on insérer des symboles dans une inputBox?

copie/coller ça ne fonctionne pas pour ces symboles récupèré dans Excel:

∑ ⌐ ᴨ ∆ ◊ ¥ π

merci

et bonne soirée

Bonjour,

Correctif pour le décalage de colonne, et insertion de la couleur pour le texte.

Option Compare Text

Sub Couleur()
    Dim DerLig_A As Long, DerLig_F As Long, N°Couleur As Long, DerCol As Long
    Dim Symbole As Variant
    Dim Titre As String
    DerLig_A = Range("A" & Rows.Count).End(xlUp).Row
    DerCol = Range("ZZ3").End(xlToLeft).Column
    If DerCol = 1 Then DerCol = 6
    Titre = Range("D1").Value
Debut:
    N°_Couleur = InputBox("Selectionnez le N° de la couleur", "Couleur")
    If N°_Couleur = "" Then Exit Sub
    Symbole = InputBox("Selectionnez le Symbole", "Symbole")
    If Symbole = "" Then Exit Sub
    DerLig_F = Cells(Rows.Count, DerCol).End(xlUp).Row
    If DerLig_F = 15 Then
        DerLig_F = 2
        DerCol = DerCol + 1
    ElseIf DerLig_F = 1 Then
        DerLig_F = 2
    End If
    With Sheets("DMC").Range("A1:A" & DerLig_A)
            Set C = .Find(N°_Couleur, lookat:=xlWhole)
            If Not C Is Nothing Then
                Cells(DerLig_F + 1, DerCol) = Titre & Chr(10) & N°_Couleur & Chr(10) & Symbole
                Cells(DerLig_F + 1, DerCol).Interior.Color = Cells(C.Row, "A").Interior.Color
                Cells(DerLig_F + 1, DerCol).Font.Color = Cells(C.Row, "A").Font.Color
            Else
                MsgBox "Couleur introuvable"
            End If
    End With
    GoTo Debut
End Sub

Pour la question2: c'est non, il faudrait que les symboles soient déjà inscrits dans des cellules comme pour les couleurs, mais le fonctionnement ne sera plus le même puisqu'il faudra saisir la cellule au lieu de passer par l'inputbox.

Cdlt

Bonjour,

Et BRAVO!

tout fonctionne à merveille

Merci

c'est vraiment sympa de consacrer votre temps à nous aider.

Passez un bon WE

A+

Bonjour,

Pour la couleur du texte, si j'ai bien compris tu as gardé la couleur existante en A par ce code :

Cells(DerLig_F + 1, DerCol).Font.Color = Cells(C.Row, "A").Font.Color

les couleurs du texte en A je les ai mis manuellement .

Mais peut-on le faire automatiquement avec une formule ou une macro?

...

J'ai un autre exercice que j'avais déjà demandé sur ce site et sur d'autres, mais les résultats ne me conviennent pas finalement.

Peut-on trié par couleur, comme dans la colonne 'arc-en-ciel' =H, (ci-joint fichier) , les couleurs se trouvant dans la feuille 'àTrierParCouleur' =A en gardant le texte ?

Merci

Salut,

Faute de grives on mange du merle...

2- Peut-on insérer des symboles dans une inputBox?

Tu peux créer un UserForm avec un Combobox par exemple, tu sélectionnes la police de caractère sur une police où tu trouvera tes symboles.

1-Est-il possible , en automatique, d'avoir la couleur du texte différent du fond de la cellule, afin de pouvoir le lire ?

tu as la possibilité de sélectionner la police là aussi.

Range("G10").Font.ColorIndex = xlAutomatic

Bonjour et merci

mais peux-tu me faire un exemple avec UserForm avec un Combobox car je suis très débutant et ne vois pas du tout comment faire

pour ton code

Range("G10").Font.ColorIndex = xlAutomatic

cela ne fonctionne pas si la couleur de la cellule est noire ou foncée.

j'ai dû mal m'exprimer, désolé

Cdlt