Macro VBA couleurs et selection de données

Bonjour à tous,

J'ai 2 problèmes.

Dans le fichier joint, il y a 2 sheets. Sur la première je n'arrive pas à mettre en couleurs les lignes correspondantes à ce que l'utilisateur souhaite.

Comment peut on en fonction d'une variable texte surligner les lignes qui contiennent cette variable.

Dans la deuxième, je ne sais pas comment "filtrer" les informations de la sheet 1 pour pouvoir remplir les tableaux.

Merci pour votre aide, et bonne année.

Salut Wheday,

J'ai aussi 2 problèmes, l'ordi n'étant pas oenologue, il me réclame :
- une liste de correspondance Nom - Région ;
- une liste de correspondance Nom - Couleur

Bonne année !

A+

Bonjour et bienbenue sur le forum

Bonjour à tous

Un essai pour la 1° partie. Te convient-il ?

Bye !

Waouh génial merci beaucoup ! C'est presque trop bien fait !!

Comment peut on après avoir demandé à l'utilisateur via une inputbox récupérer ce qu'il a saisi pour ensuite surligner uniquement la région demandé ?

En tout cas c'est génial un grand merci !!

Purée, j'ai réussi à zapper les colonnes [A:B]...
Z'avez dû me prendre pour un fou...

J'y retourne...

A+

J'ai trouvé la solution à mon 1er problème !!

Dim r As String
r = InputBox("Quelle région ?")
Range("A2:H2").Select

Do While ActiveCell.Value <> ""
If UCase(ActiveCell.Offset.Value) = UCase(r) Then
Selection.Interior.Color = RGB(112, 188, 243)
Else
Selection.Interior.Color = xlNone
End If
Selection.Offset(1, 0).Select
Loop

Si vous pouviez m'aider ,pour la 2ème sheet je vous en serai très reconnaissant !
merci

Salut Wheday,
Salut gmb,

comme gmb, , 1ère partie...
- conversion des valeurs "Prix" à l'ouverture du fichier ;

With Worksheets("BDD")
    If InStr(.[F2], ".") > 0 Then
        tTab = .Range("F2:H" & .Range("A" & Rows.Count).End(xlUp).Row).Value
        For x = 1 To UBound(tTab, 1)
            tTab(x, 1) = Val(Replace(tTab(x, 1), ".", ","))
            tTab(x, 3) = Val(Replace(tTab(x, 3), ".", ","))
        Next
        .Columns("F").ClearContents
        .Columns("H").ClearContents
        .Columns("F").NumberFormat = "0.00 €"
        .Columns("H").NumberFormat = "0.00 €"
        .Range("F2:H" & Range("A" & Rows.Count).End(xlUp).Row).Value = tTab
    End If
End With

- histoire d'alléger le "fonctionnement" de la recherche de la région, un clic en [A1] crée une liste de validation, suffisante pour le besoin ;

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim iRow1%, iRow2%
'
Application.EnableEvents = False
'
With Range("A1:H" & Range("A" & Rows.Count).End(xlUp).Row)
    .Sort _
        key1:=Range("E2"), order1:=xlAscending, _
        key2:=Range("D2"), order2:=xlAscending, _
        Orientation:=xlTopToBottom, Header:=xlYes
    .Sort _
        key1:=Range("A2"), order1:=xlAscending, _
        key2:=Range("B2"), order2:=xlAscending, _
        key3:=Range("C2"), order3:=xlAscending, _
        Orientation:=xlTopToBottom, Header:=xlYes
End With
Columns.AutoFit
'
If Not Intersect(Target, Range("A1")) Is Nothing Then
    Range("A2:H" & Range("A" & Rows.Count).End(xlUp).Row).Interior.Color = xlNone
    iRow1 = Columns(1).Find(what:=Target, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
    iRow2 = Columns(1).Find(what:=Target, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
    Range("A" & iRow1 & ":A" & iRow2).Interior.Color = RGB(110, 190, 245)
    ActiveWindow.ScrollRow = iRow1
    Target = "REGION"
End If
'
Application.EnableEvents = True
'
End Sub

- coloration des cellules "Région" et ScrollRow vers les lignes ciblées ;
- un double-clic sur la feuille annule la recherche.

La suite au prochain numéro...

Bonne année !

A+

Top merci beacoup Curulis !

Hate d'avoir le prochain numéro

1/2 numéro seulement : j'avais omis le premier résultat demandé...

    MsgBox "Région " & Target & Chr(10) & Chr(10) & "Nombres de bouteilles : " & WorksheetFunction.Sum(Range("G" & iRow1 & ":G" & iRow2)) & _
        Chr(10) & "Valorisation du stock : " & WorksheetFunction.Sum(Range("H" & iRow1 & ":H" & iRow2)) & " €"

+ une amélioration structurelle lors d'un changement dans la BDD : la BDD n'est triée QUE lorsqu'une ligne est complète

If WorksheetFunction.CountA(Range("A" & iRow1 & ":H" & iRow1)) = 8 Then

A+

Salut Wheday,
Salut gmb,

Première utilisation de SOMMEPROD de ma life... Je demande l'aide d'un ami pro des formules pour confirmer...

A+