Script VBA differentes conditions Résolu/Fermé

Question

Bonjour,
j'ai un petit souci avec mon code si quelqu'un peu m'aider ce serait cool :).

Je veux afficher le résultat d'une fonction selon plusieurs critere.
C'est a dire avec un choix 1 ( France ) en case A2 et un choix 2 ( Janvier ) en case A3 dans la feuil1 par exemple.

La fonction cherche les données A2 dans la colonne 1 de la feuil2 et les données A3 dans la colonne 4.
Le résultat affiche seulement les lignes ou se trouve le choix1 et le choix2 dans la même ligne.
Donc la fonction ne retient que les données situer dans la feuil2 ayant France dans la colonne A et janvier dans la colonne D et m'affiche le resultat dans la feuil1 a partir de la case renommer resultat_test.

Je vous presente mon script auquel je suis arriver pour le moment.

-----------------------------------------------------------------------------------------------

Option Explicit

Const colonne As Byte = 12

-----------------------------------------------------------------------------------------------

Sub nettoyertest()

Sheets("feuil1").Range("resultatest").Resize(100, colonne).Clear

End Sub

----------------------------------------------------------------------------------------------

Sub test()

Dim valeur, valeur2
Dim comparaison As Byte
Dim tablo
Dim ligne As Byte, compteur_y As Byte, compteur_x As Byte

valeur = Range("choix1")
valeur2 = Range("choix2")

With Sheets("feuil2")

    comparaison = Application.CountIf(.Columns(1), valeur)
    ReDim tablo(comparaison - 1, colonne - 1)
    ligne = 1
    For compteur_y = 0 To UBound(tablo)
        ligne = .Columns(1).Find(valeur, .Cells(ligne, 1), xlValues).Row And .Columns(4).Find(valeur2, .Cells(ligne, 4), xlValues).Row
        For compteur_x = 0 To colonne - 1
            tablo(compteur_y, compteur_x) = .Cells(ligne, compteur_x + 1)
        Next
    Next
    
End With

nettoyertest

Application.ScreenUpdating = False
Sheets("feuil1").Activate
With Range("resultatest").Resize(comparaison, colonne)
    .Value = tablo
    .Borders.Weight = xlThin
End With

End Sub

------------------------------------------------------------------------------

Il y a aussi une chose qui me chagrine c'est que je ne trouve pas comment faire pour faire en sorte que si le choix 1 ou le choix 2 est vide cela revient à ne pas préciser donc cela revient à ne pas avoir de critère spécifique. Cependant si je ne met aucune valeur il m'indique une erreur de sélection et arrête mon script :'(.





J'ai besoin d'aide. Merci a vous.
a+

goomis95 · Answer

J'ai reussi a contourner le probleme pour creer un tableau dans une feuil3 du resultat chercher en suite a partir de ce résultat puis réecrire le nouveau tableau dessu etc ... et a la fin l'ecrire la ou je veux et effacer ce qu'il y a dans la feuil3 ( astucieux hein ? :) lol).

Cependant je n'arrive pas a faire en sorte que si mon choix est nul cela signifie qu'il n'y a pas de valeur précise :'(.
Je vais essayer de contourner une enieme fois ce probleme mais si quelqu'un pouvait me me donner une solution ca serait cool.

J'ai ca qui ne fonctionne pas : 

If IsEmpty(valeur) Then
valeur = Range("A")
Endif

goomis95 · Answer

Je fais un petit up je suis sur que ca n'est pas tres compliquer mais moi je sais pas comment le faire pour le moment :)

goomis95 · Answer

Merci de votre aide ( on sais jamais vous m'auriez surement aider :) )

J'ai trouver tout seul pour ceux que ca interesse on ne sais jamais je vous met le code :

------------------------------------------------------------------------
Option Explicit

Const colonne As Byte = 3
------------------------------------------------------------------------
Sub nettoyertest()

Sheets("feuil1").Range("resultatest").Resize(100, colonne).Clear

End Sub
Sub test1()

Sheets("feuil3").Range("test1").Resize(100, colonne).Clear

End Sub
-------------------------------------------------------------------------
Sub test()

Dim valeur
Dim comparaison As Byte
Dim tablo
Dim ligne As Byte, compteur_y As Byte, compteur_x As Byte
Dim iii As Integer

valeur = Range("choix1")

If IsEmpty(valeur) Then
        With Sheets("feuil2")
        iii = ActiveSheet.UsedRange.Rows.Count
        ReDim tablo(iii - 1, colonne - 1)
        ligne = 1
            For compteur_y = 0 To UBound(tablo)
                For compteur_x = 0 To colonne - 1
                tablo(compteur_y, compteur_x) = .Cells(compteur_y + 1, compteur_x + 1)
                Next
            Next
        End With
        test1
        Application.ScreenUpdating = False
        Sheets("feuil3").Activate
           With Range("test1").Resize(iii, colonne)
           .Value = tablo
           End With
Else
        With Sheets("feuil2")
        comparaison = Application.CountIf(.Columns(1), valeur)
        ReDim tablo(comparaison - 1, colonne - 1)
        ligne = 1
            For compteur_y = 0 To UBound(tablo)
            ligne = .Columns(1).Find(valeur, .Cells(ligne, 1), xlValues).Row
                For compteur_x = 0 To colonne - 1
                tablo(compteur_y, compteur_x) = .Cells(ligne, compteur_x + 1)
                Next
            Next
        End With
        test1
        Application.ScreenUpdating = False
        Sheets("feuil3").Activate
           With Range("test1").Resize(comparaison, colonne)
           .Value = tablo
           End With
End If

valeur = Range("choix2")

If IsEmpty(valeur) Then
        With Sheets("feuil3")
        iii = ActiveSheet.UsedRange.Rows.Count
        ReDim tablo(iii - 1, colonne - 1)
        ligne = 1
            For compteur_y = 0 To UBound(tablo)
                For compteur_x = 0 To colonne - 1
                tablo(compteur_y, compteur_x) = .Cells(compteur_y + 1, compteur_x + 1)
                Next
            Next
        End With
        test1
        nettoyertest
        Application.ScreenUpdating = False
        Sheets("feuil1").Activate
           With Range("resultatest").Resize(iii, colonne)
           .Value = tablo
           .Borders.Weight = xlThin
           End With
Else
        With Sheets("feuil3")
        comparaison = Application.CountIf(.Columns(2), valeur)
        ReDim tablo(comparaison - 1, colonne - 1)
        ligne = 1
            For compteur_y = 0 To UBound(tablo)
            ligne = .Columns(2).Find(valeur, .Cells(ligne, 2), xlValues).Row
                For compteur_x = 0 To colonne - 1
                tablo(compteur_y, compteur_x) = .Cells(ligne, compteur_x + 1)
                Next
            Next
        End With
        test1
        nettoyertest
        Application.ScreenUpdating = False
        Sheets("feuil1").Activate
            With Range("resultatest").Resize(comparaison, colonne)
            .Value = tablo
            .Borders.Weight = xlThin
            End With
End If
End Sub

Script VBA differentes conditions

3 réponses

Discussions similaires