Selection avec conditions VBA

Le 22/08/2018 à 15:32

Bonjour,

J'ai codé cette petite boucle qui permet de selectioner les valeurs qu'ont un Percentage of growth/Decline Par mois superieur a une donnee fixe dans la feuille criteria qui change par mois.

J'aimerai que pour chaque mois si les valeurs dans Percentage of growth/Decline sup A Per for Growth select soient copie dans l'onglet PTF pour le mois qui corrsponds.

n'hesitez pas si vous avez des solutions

Merci

9selction-cnd.xlsm (31.36 Ko)

Sub test(trigger, Feuille)

i = 2

t = 3

Do Until ThisWorkbook.Sheets("ptf").Cells(t, 1).Value = ""

t = t + 1

Loop

Do Until ThisWorkbook.Sheets(Feuille).Cells(i, 3).Value = ""

If ThisWorkbook.Sheets(Feuille).Cells(i, 3).Value > trigger Then

ThisWorkbook.Sheets("Ptf").Cells(t, 1).Value = ThisWorkbook.Sheets(Feuille).Cells(i, 1).Value

t = t + 1

End If

i = i + 1

Loop

End Sub

Sub Lancer()

Sheets("Ptf").Select

Worksheets("Ptf").Range("A3:A1137").Clear

Call test(Sheets("Criteria").Range("B2"), "Utl")

Call test(Sheets("Criteria").Range("B3"), "Tele")

Call test(Sheets("Criteria").Range("B4"), "Tech")

End Sub

Le 22/08/2018 à 16:09

UP please

Le 22/08/2018 à 16:14

bonjour

avec un TCD comme ceci

Le 22/08/2018 à 16:18

C'est pas possible car la vrai table de données est plus grand que ca; il va falloir plus de rechercheVa gere alors que avec une boucle c'est simple et précis....

Le 22/08/2018 à 16:25

bonjour,

une solution possible

Sub test(trigger, Feuille)

    i = 2
    choix = 2 ' choix de présentation, 1 avec blanc, 2 sans blanc
    If choix = 1 Then t = ThisWorkbook.Sheets("ptf").Cells(Rows.Count, 1).End(xlUp).Row
    Do Until ThisWorkbook.Sheets(Feuille).Cells(i, 3).Value = ""
        f = 0
        For j = 3 To 7
            If ThisWorkbook.Sheets(Feuille).Cells(i, j).Value > trigger Then
                If choix = 1 Then
                    If f = 0 Then f = 1: t = t + 1
                Else
                    t = ThisWorkbook.Sheets("ptf").Cells(Rows.Count, j - 2).End(xlUp).Row + 1
                End If
                ThisWorkbook.Sheets("Ptf").Cells(t, j - 2).Value = ThisWorkbook.Sheets(Feuille).Cells(i, 1).Value
            End If
        Next j
        i = i + 1
    Loop

End Sub
Sub Lancer()

    Sheets("Ptf").Select

    Worksheets("Ptf").Range("A3:Z1137").Clear

    Call test(Sheets("Criteria").Range("B2"), "Utl")
    Call test(Sheets("Criteria").Range("B3"), "Tele")
    Call test(Sheets("Criteria").Range("B4"), "Tech")

End Sub
Le 22/08/2018 à 16:26

j'ai fait rapide

une feuille qui reprend tes 3 onglets grâce à des =

j'en ai fait 2, tu feras la 3

s'il y a jusqu'à 10000 lignes par onglet, on fait comme ça : simple

si plus, faire Données, Obtenir, 3 fois et concaténer les reqûetes (append) : me demander.

ensuite une colonne de pointage avec un SI

c'est très simple

à toi de fignoler la formule des SI imbriqués

tu filtres selon la colonne de pointage

pas de VBA, juste des = et des SI()

simple non ?

3copie-de-selction-cnd.xlsm (66.18 Ko)
Le 22/08/2018 à 16:30
h2so4 a écrit :

bonjour,

une solution possible

Sub test(trigger, Feuille)

    i = 2
    choix = 2 ' choix de présentation, 1 avec blanc, 2 sans blanc
    If choix = 1 Then t = ThisWorkbook.Sheets("ptf").Cells(Rows.Count, 1).End(xlUp).Row
    Do Until ThisWorkbook.Sheets(Feuille).Cells(i, 3).Value = ""
        f = 0
        For j = 3 To 7
            If ThisWorkbook.Sheets(Feuille).Cells(i, j).Value > trigger Then
                If choix = 1 Then
                    If f = 0 Then f = 1: t = t + 1
                Else
                    t = ThisWorkbook.Sheets("ptf").Cells(Rows.Count, j - 2).End(xlUp).Row + 1
                End If
                ThisWorkbook.Sheets("Ptf").Cells(t, j - 2).Value = ThisWorkbook.Sheets(Feuille).Cells(i, 1).Value
            End If
        Next j
        i = i + 1
    Loop

End Sub
Sub Lancer()

    Sheets("Ptf").Select

    Worksheets("Ptf").Range("A3:Z1137").Clear

    Call test(Sheets("Criteria").Range("B2"), "Utl")
    Call test(Sheets("Criteria").Range("B3"), "Tele")
    Call test(Sheets("Criteria").Range("B4"), "Tech")

End Sub

Merci pour votre reponse, ça regle la moitie de mon probleme le seul souci qui reste mtn c'est comment rendre pour que chaque mois il choisi le critere mis la cellule reference fixe ?

Sub Lancer()

Sheets("Ptf").Select

Worksheets("Ptf").Range("A3:Z1137").Clear

Call test(Sheets("Criteria").Range("B2"), "Utl")

Call test(Sheets("Criteria").Range("B3"), "Tele")

Call test(Sheets("Criteria").Range("B4"), "Tech")

Call test(Sheets("Criteria").Range("c2"), "Utl")

Call test(Sheets("Criteria").Range("c3"), "Tele")

Call test(Sheets("Criteria").Range("c4"), "Tech")

Call test(Sheets("Criteria").Range("d2"), "Utl")

Call test(Sheets("Criteria").Range("d3"), "Tele")

Call test(Sheets("Criteria").Range("d4"), "Tech")

End Sub

Le 22/08/2018 à 17:16

re-bonjour,

pas sûr d'avoir compris ...

Sub test(trigger, Feuille)

    i = 2
    choix = 2 ' choix de présentation, 1 avec blanc, 2 sans blanc
    If choix = 1 Then t = ThisWorkbook.Sheets("ptf").Cells(Rows.Count, 1).End(xlUp).Row
    Do Until ThisWorkbook.Sheets(Feuille).Cells(i, 3).Value = ""
        f = 0
        For j = 3 To 7
            If ThisWorkbook.Sheets(Feuille).Cells(i, j).Value > trigger.Offset(, j - 3) Then
                If choix = 1 Then
                    If f = 0 Then f = 1: t = t + 1
                Else
                    t = ThisWorkbook.Sheets("ptf").Cells(Rows.Count, j - 2).End(xlUp).Row + 1
                End If
                ThisWorkbook.Sheets("Ptf").Cells(t, j - 2).Value = ThisWorkbook.Sheets(Feuille).Cells(i, 1).Value
            End If
        Next j
        i = i + 1
    Loop

End Sub
Le 22/08/2018 à 17:24

la logique c'est que par secteur et par mois on prends le critere qui corrsponds dans l'onglet Criteria

donc Mois de Janvier : les criteres sont dans l'onglet "Criteria" en B2 à B4

Mois de Fev : les criteres sont dans l'onglet "Criteria" en C2 à C4 etc etc

le code permet selectioner les valeurs avec des critere b2 a B4 ce qui correct pour le 1er mois mais pas pour le mois d'apres il a doit prendre en critere en l'onglet "Criteria" en C2 à C4

Le 22/08/2018 à 17:39
h2so4 a écrit :

re-bonjour,

pas sûr d'avoir compris ...

Sub test(trigger, Feuille)

    i = 2
    choix = 2 ' choix de présentation, 1 avec blanc, 2 sans blanc
    If choix = 1 Then t = ThisWorkbook.Sheets("ptf").Cells(Rows.Count, 1).End(xlUp).Row
    Do Until ThisWorkbook.Sheets(Feuille).Cells(i, 3).Value = ""
        f = 0
        For j = 3 To 7
            If ThisWorkbook.Sheets(Feuille).Cells(i, j).Value > trigger.Offset(, j - 3) Then
                If choix = 1 Then
                    If f = 0 Then f = 1: t = t + 1
                Else
                    t = ThisWorkbook.Sheets("ptf").Cells(Rows.Count, j - 2).End(xlUp).Row + 1
                End If
                ThisWorkbook.Sheets("Ptf").Cells(t, j - 2).Value = ThisWorkbook.Sheets(Feuille).Cells(i, 1).Value
            End If
        Next j
        i = i + 1
    Loop

End Sub

Ca me rends fou, je suis sur que la solution est trop simple mais je n'arrive plus

Le 22/08/2018 à 18:57

up please

Le 22/08/2018 à 19:21
themindhaze a écrit :

la logique c'est que par secteur et par mois on prends le critere qui corrsponds dans l'onglet Criteria

donc Mois de Janvier : les criteres sont dans l'onglet "Criteria" en B2 à B4

Mois de Fev : les criteres sont dans l'onglet "Criteria" en C2 à C4 etc etc

le code permet selectioner les valeurs avec des critere b2 a B4 ce qui correct pour le 1er mois mais pas pour le mois d'apres il a doit prendre en critere en l'onglet "Criteria" en C2 à C4

selon moi, c'est bien comme cela que cela se passe.

Rechercher des sujets similaires à "selection conditions vba"