Script VBA differentes conditions
Résolu
goomis95
Messages postés
40
Statut
Membre
-
goomis95 Messages postés 40 Statut Membre -
goomis95 Messages postés 40 Statut Membre -
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+
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+
Configuration: Windows XP Firefox 3.0.15
3 réponses
-
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 -
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 :)
-
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
