Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

amélioration_programme

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion kakachi
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
K

kakachi

Guest
Bonsoir le forum ,

Je me tourne vers vous afin d'optimiser mon programme VBA.

le problème que j'ai actuellement avec mon programme est, dès que j'appuie sur le bouton de commande " afficher les combinaisons", le tableau intitulé "COMBINAISONS" disparait et la couleur de fond aussi.Seuls les valeurs restent.

J'aimerai aussi, que le programme prenne uniquement les valeurs définies dans le tableau "a2:d7".
Si je rajoute une valeur , par exemple,dans la cellule "A8", le programme prendra en compte cette valeur .Je souhaite juste que la macro utilise les valeurs définies dans le tableau "a2:d7".

Afin d'optimiser mon programme, j'aimerai que:

1=>le programme prenne uniquement les valeurs définies dans le tableau "a2:d7".

2=>le tableau "COMBINAISONS" et la couleur de fond ne disparaissent pas quand j'appuie sur le bouton de commande " Afficher les combinaisons "


Merci pour ceux qui voudront bien m'aider !!!

Bonne nuit!!

kakach
 

Pièces jointes

Dernière modification par un modérateur:
Trier par date Trier par votes
Re : amélioration_programme

Bonjour,

Testez le code suivant:
Code: 
Sub combin()

Dim i As Long, J As Long, K As Long, L As Long, Ligne As Long
Dim G1 As Long, G2 As Long, G3 As Long, G4 As Long

G1 = Range("A65536").End(xlUp).Row: If G1 > 7 Then G1 = 7
G2 = Range("B65536").End(xlUp).Row: If G2 > 7 Then G2 = 7
G3 = Range("C65536").End(xlUp).Row: If G3 > 7 Then G3 = 7
G4 = Range("D65536").End(xlUp).Row: If G4 > 7 Then G4 = 7

Range("E2:H65536").ClearContents

Ligne = 2
For i = 2 To G1
  For J = 2 To G2
    For K = 2 To G3
      For L = 2 To G4
            Range("E" & Ligne) = Range("A" & i)
            Range("F" & Ligne) = Range("B" & J)
            Range("G" & Ligne) = Range("C" & K)
            Range("H" & Ligne) = Range("D" & L)
            Ligne = Ligne + 1
     Next L
    Next K
  Next J
Next i
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : amélioration_programme

Bonjour,

Peut-être comme ceci:

Code: 
Sub combin()

Dim i As Long, J As Long, K As Long, L As Long, Ligne As Long
Dim G1 As Long, G2 As Long, G3 As Long, G4 As Long

G1 = Range("A8").End(xlUp).Row
G2 = Range("B8").End(xlUp).Row
G3 = Range("C8").End(xlUp).Row
G4 = Range("D8").End(xlUp).Row

Range("E2:H65536").ClearContents

Ligne = 2
For i = 2 To G1
  For J = 2 To G2
    For K = 2 To G3
      For L = 2 To G4
            Range("E" & Ligne) = Range("A" & i)
            Range("F" & Ligne) = Range("B" & J)
            Range("G" & Ligne) = Range("C" & K)
            Range("H" & Ligne) = Range("D" & L)
            Ligne = Ligne + 1
     Next L
    Next K
  Next J
Next i
 
   
End Sub
 
Vote positif 0 Vote négatif
Re : amélioration_programme

Bonjour mapomme,

Un petit problème avec ton code:

Si tu as une valeur par exemple en A8 et rien en A7, il retiendra comme dernière ligne 7 au lieu de 6.
Maintenant à kakachi de voir si le cas peut se présenter.

Cordialement
 
Vote positif 0 Vote négatif
Re : amélioration_programme

Bonjour,
Très juste! On part du haut et on descend. Le cas où une colonne est vide n'est pas géré. Le cas où des cellules vides s'intercalent entre des cellules renseignées n'est pas géré.

Edit (9h38) : pour tenir compte des 2 cas cités ci-dessus (colonne vide ou cellule vide intercalée)
Code: 
Sub combin()

Dim i As Long, J As Long, K As Long, L As Long, Ligne As Long
Dim G1 As Long, G2 As Long, G3 As Long, G4 As Long, Nonvide

G1 = Range("A1").End(xlDown).Row: If G1 > 7 Then G1 = 7
Nonvide = Nonvide + Evaluate("COUNTIF(" & Range("A2:A" & G1).Address & ",""<>"""""")")

G2 = Range("B1").End(xlDown).Row: If G2 > 7 Then G2 = 7
Nonvide = Nonvide + Evaluate("COUNTIF(" & Range("B2:B" & G2).Address & ",""<>"""""")")

G3 = Range("C1").End(xlDown).Row: If G3 > 7 Then G3 = 7
Nonvide = Nonvide + Evaluate("COUNTIF(" & Range("C2:C" & G3).Address & ",""<>"""""")")

G4 = Range("D1").End(xlDown).Row: If G4 > 7 Then G4 = 7
Nonvide = Nonvide + Evaluate("COUNTIF(" & Range("D2:D" & G4).Address & ",""<>"""""")")

If Nonvide <> 24 - Evaluate("COUNTIF(" & Range("A2:D7").Address & ","""")") Then
    MsgBox " présence de colonnes vides ou cellules vides intercalées ==> STOP!"
    Exit Sub
End If

Range("E2:I65536").ClearContents

Ligne = 2
For i = 2 To G1
  For J = 2 To G2
    For K = 2 To G3
      For L = 2 To G4
            Range("E" & Ligne) = Range("A" & i)
            Range("F" & Ligne) = Range("B" & J)
            Range("G" & Ligne) = Range("C" & K)
            Range("H" & Ligne) = Range("D" & L)
            Ligne = Ligne + 1
     Next L
    Next K
  Next J
Next i
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

D
  • Résolu(e)
XL 2019 Report valeur et mise en couleur
Réponses
9
Affichages
224
DST
D
A
  • Résolu(e)
Microsoft 365 Afficher Masquer tableau selon critères + MàJ Autom. TCD en VBA
Réponses
8
Affichages
662
Amilo
A
  • Résolu(e)
XL 2010 Création de listes déroulantes interactive
6 7 8
Réponses
113
Affichages
5 K
job75
  • Question Question
Microsoft 365 Utilisation d'un module VBA en tâche de fond
Réponses
5
Affichages
145
aspect
  • Question Question
XL 2021 Détecter un changement dans un des contrôles de formulaire et mettre à jour un TS correspondant.
2
Réponses
15
Affichages
714
jeff1494
E
  • Question Question
Microsoft 365 reference ou famille
2 3
Réponses
32
Affichages
777
Piment
P
A
  • Résolu(e)
Autres modification Macro tableau excel
Réponses
2
Affichages
272
Audrey62
A
F
  • Question Question
XL 2016 Graphique avoir des blancs en non des valeurs à 0 quand la donnée est vide
Réponses
4
Affichages
258
JHA
J
C
  • Question Question
Microsoft 365 Automatiser un graphique avec excell 365
Réponses
11
Affichages
527
job75
  • Résolu(e)
Microsoft 365 Concaténer colonne d'un tableau des cases visibles uniquement
Réponses
12
Affichages
550
Jean-Eric
B
  • Résolu(e)
XL 2021 compter les cellules de la même couleur
2 3
Réponses
36
Affichages
2 K
mapomme
R
  • Question Question
XL pour MAC Ne pas afficher valeurs nulles dans un graphique
Réponses
5
Affichages
337
rtlv17
R
  • Question Question
Microsoft 365 Calcul total horaire entre 1er jour et dernier jour de chaque mois
Réponses
5
Affichages
342
pompaero
S
  • Résolu(e)
Microsoft 365 Extraire les différences entre 2 colonnes
Réponses
7
Affichages
297
Sissou71
S
S
  • Question Question
XL 2019 Fichier de tirage au sort sans doublons avec valeurs en plus
Réponses
1
Affichages
492
sylvanu
  • Question Question
Microsoft 365 Variable tableau : coller uniquement une partie des colonnes
2 3
Réponses
31
Affichages
2 K
BenHarber
S
  • Question Question
Microsoft 365 Tableaux Structurées : récupérer des données uniques pour consolider un bilan
Réponses
4
Affichages
420
vgendron
Z
  • Question Question
Microsoft 365 Recherche d'une valeur max dans un tableau représentant des paliers
Réponses
3
Affichages
358
zedude
Z
B
  • Question Question
XL 2019 Conserver les formules qui sont enregistrées dans des cellules
Réponses
8
Affichages
606
Phil69970
  • Résolu(e)
XL 2013 (RESOLU) Affichage des résultats dans un tableau selon des conditions
Réponses
13
Affichages
1 K
chaelie2015
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…