CODE 500 lignes

MADAGASCAR

MADAGASCAR

XLDnaute Occasionnel
Bonjour EXCEL DOWNLOADS
Bonjour à tous et à toutes
Une autre fois SVP chers membres je sollicite vos aides ou vos idees afin de finir cet usine a dynamite
J'ai essayé de completer ce code avec ma connaissance tres limitee en VBA et j'ai trouvé que je dois mettre environ 500 lignes dans mon code ..
Dans la colonne C ( colonne de categorie de 1 à 17 )
Catégorie 1 possede 12 échelon de 1 à 12
Catégorie 2 possede 12 échelon de 1 à 12
Catégorie 3 possede 12 échelon de 1 à 12
ainsi de suite pour toutes les 17 catégories
Catégorie 1 échelon1 à une valeur spéciale unique qui reste toujour la meme jusqu'a l'infini (9450)
Catégorie 1 échelon2 à une valeur spéciale unique qui reste toujour la meme jusqu'a l'infini (9900)
Catégorie 1 échelon3 à une valeur spéciale unique qui reste toujour la meme jusqu'a l'infini (10350)
et ainsi de suite pour ces 12 échelons
Je vais repeter cette procedure pour toutes les categories et les echelons
A la fin avec mon code dans ce fichier je vais atteindre presque 500 lignes car je ne veux pas passer par l'onglet d'excel
SVP est ce qu'il ya un moyen de sortir avec un code un peu plus petit sinon je vais patiner avec mon super code
Merci beaucoup d'avance pour n'importe quelle idee ou suggestion
Cordialement
MADA BLACK
 

Pièces jointes

  • mada.xlsm
    21.5 KB · Affichages: 47
  • mada.xlsm
    21.5 KB · Affichages: 43
Trier par date Trier par votes
C

Caillou

XLDnaute Impliqué
Re : CODE 500 lignes

Bonjour,

Je ne suis pas sur d'avoir compris:
sinon, voila ce que j'ai fait :
- J'ai nommé la plage D5 à 021 --> Tablo
- ensuite en vba, j'ai créé la procédure
Code: 
Private Sub CommandButton1_Click()
  On Error GoTo fin
  Dim categorie As Byte
  Dim echelon As Byte
  Dim res As Variant
  
  categorie = CByte(ComboBox1)
  echelon = CByte(ComboBox2)
  
  res = Application.WorksheetFunction.Index(Range("tablo"), categorie, echelon)
  TextBox1 = res
fin:
End Sub
Caillou
 
Vote positif 0 Vote négatif
L

laetitia90

XLDnaute Barbatruc
Re : CODE 500 lignes

bonjour MADAGASCAR:)
une approche simple

code user

Code: 
Private Sub UserForm_Initialize()
For i = 1 To 17: ComboBox1.AddItem (i): Next i
For i = 1 To 12: ComboBox2.AddItem (i): Next i
End Sub
Private Sub ComboBox1_Change()
If ComboBox2 <> "" Then TextBox1 = Cells(ComboBox1 + 4, ComboBox2 + 3)
End Sub
Private Sub ComboBox2_Change()
If ComboBox1 <> "" Then TextBox1 = Cells(ComboBox1 + 4, ComboBox2 + 3)
End Sub


PS: bonjour Caillou :) pas rafraichi
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re : CODE 500 lignes

Bonjour MADAGASCAR, Caillou

je ne veux pas passer par l'onglet d'excel
Cliquez pour agrandir...

il faudra donc écrire en 'dur' dans le code la valeur des différents échelons, par exemple

Code: 
Private Sub ComboBox2_Change()
 Dim  Cat(17) 

 Cat(0) = Array("9450", "9900", "10350", "10800", "11250", "11700", "12150", "12600", "13050", "13500", "14400")
 Cat(1) = Array("xxxx", "xxxx", "xxxx", "xxxx", "xxxx", "xxxx", "xxxx", "xxxx", "xxxx", "xxxx", "xxxx")
 Cat(2) = ...
 Cat(3) = ...
 ....
 Cat(16) = Array("zzzz", "zzzz", "zzzz", "zzzz", "zzzz", "zzzz", "zzzz", "zzzz", "zzzz", "zzzz", "zzzz")

 TextBox1.Text = Cat(ComboBox1.ListIndex)(ComboBox2.ListIndex)
End  Sub

alors qu'en utilisant les valeurs de la feuille :

Code: 
Private Sub ComboBox2_Change()
 Dim CatEch
 CatEch = Range("D5:O21")
 TextBox1 = CatEch(ComboBox1.ListIndex + 1, ComboBox2.ListIndex + 1)
End  Sub

A+

edit : bonjour laetitia90
 
Dernière édition:
Vote positif 0 Vote négatif
gosselien

gosselien

XLDnaute Barbatruc
Re : CODE 500 lignes

Bonjour,

rien tenté mais ...

entre le 9450 du textbox1.text et les suivants, il y a toujours 450 de différence, ça permettrait peut être de raccourcir non ?
:)

edit: oups....pas lu tout les chiffres du tableau , sorry

edit2: "car je ne veux pas passer par l'onglet d'excel" il y a une raison particulière à cette affirmation ?
 
Dernière édition:
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : CODE 500 lignes

Bonjour à tous.


Je ne sais pas si j'ai compris. À tout hasard :​
Code: 
Private Sub ComboBox2_Change()
  On Error Resume Next
  TextBox1.Text = toto(ComboBox2.Value, ComboBox1.Value)
  If Err.Number Then TextBox1.Text = "?"
End Sub

Function toto&(cat%, éch%)
  toto = Array(, Array(, 9450, 9900, 10350, 10800, 11250, 11700, 12150, 12600, 13050, 13500, 13950, 14400), _
    Array(, 10350, 10845, 11340, 11835, 12330, 12825, 13320, 13815, 14310, 14805, 15255, 15750), _
    Array(, 458796, 254879, 12457, 22222, 12457, 22222, 12457, 22222, 12457, 22222, 12457, 22222), _
    Array(, 4444, 555555, 4789654, 1133985, 12330, 12825, 13320, 12600, 13050, 14805, 15255, 15750), _
    Array(, 25845, 555, 77, 9966, 12458, 22223, 12458, 13815, 14310, 22223, 12458, 22223), _
    Array(, 125487, 2222, 555, 25478, 12330, 12825, 13320, 22223, 12458, 14805, 15255, 15750), _
    Array(, 5576584, 1254, 2222, 525698, 12459, 22224, 12459, 12600, 13050, 14805, 12459, 22224), _
    Array(, 885511, 555555, 5555, 745851, 12330, 12825, 13320, 13815, 14310, 22223, 15255, 15750), _
    Array(, 74458967, 44444, 2547, 4444425, 12460, 22225, 12460, 22224, 12459, 14805, 12460, 22225), _
    Array(, 254698, 55555, 22222, 55555, 12330, 12825, 13320, 12600, 13050, 22224, 15255, 15750), _
    Array(, 78596, 522222, 555555, 24785, 12461, 22226, 12461, 13815, 14310, 14805, 12461, 22226), _
    Array(, 5555, 457892, 5874695, 5874529, 12330, 12825, 13320, 22225, 12460, 14805, 15255, 15750), _
    Array(, 8888, 2548962, 58495, 587458, 12462, 22227, 12462, 12600, 13050, 22224, 12462, 22227), _
    Array(, 77777, 54785369, 24875236, 54782, 12330, 12825, 13320, 13815, 14310, 14805, 15255, 15750), _
    Array(, 444444, 25478, 888888, 888888, 12463, 22228, 12463, 22226, 12461, 22225, 12463, 22228), _
    Array(, 555, 5555555, 555555, 555555, 12330, 12825, 13320, 12600, 13320, 14805, 15255, 15750), _
    Array(, 78542, 48567, 25687, 547823, 12464, 22229, 12464, 13815, 12465, 14805, 12464, 22229))(éch)(cat)
End Function
Je ne me suis pas amusé à saisir les valeurs dans le code : quelques formules simples permettent de créer la chaîne


"Array(, Array(, 9450, 9900, 10350, 10800, 11250, 11700, 12150, 12600, 13050, 13500, 13950, 14400), _
Array(, 10350, 10845, 11340, 11835, 12330, 12825, 13320, 13815, 14310, 14805, 15255, 15750), _
Array(, 458796, 254879, 12457, 22222, 12457, 22222, 12457, 22222, 12457, 22222, 12457, 22222), _
Array(, 4444, 555555, 4789654, 1133985, 12330, 12825, 13320, 12600, 13050, 14805, 15255, 15750), _
Array(, 25845, 555, 77, 9966, 12458, 22223, 12458, 13815, 14310, 22223, 12458, 22223), _
Array(, 125487, 2222, 555, 25478, 12330, 12825, 13320, 22223, 12458, 14805, 15255, 15750), _
Array(, 5576584, 1254, 2222, 525698, 12459, 22224, 12459, 12600, 13050, 14805, 12459, 22224), _
Array(, 885511, 555555, 5555, 745851, 12330, 12825, 13320, 13815, 14310, 22223, 15255, 15750), _
Array(, 74458967, 44444, 2547, 4444425, 12460, 22225, 12460, 22224, 12459, 14805, 12460, 22225), _
Array(, 254698, 55555, 22222, 55555, 12330, 12825, 13320, 12600, 13050, 22224, 15255, 15750), _
Array(, 78596, 522222, 555555, 24785, 12461, 22226, 12461, 13815, 14310, 14805, 12461, 22226), _
Array(, 5555, 457892, 5874695, 5874529, 12330, 12825, 13320, 22225, 12460, 14805, 15255, 15750), _
Array(, 8888, 2548962, 58495, 587458, 12462, 22227, 12462, 12600, 13050, 22224, 12462, 22227), _
Array(, 77777, 54785369, 24875236, 54782, 12330, 12825, 13320, 13815, 14310, 14805, 15255, 15750), _
Array(, 444444, 25478, 888888, 888888, 12463, 22228, 12463, 22226, 12461, 22225, 12463, 22228), _
Array(, 555, 5555555, 555555, 555555, 12330, 12825, 13320, 12600, 13320, 14805, 15255, 15750), _
Array(, 78542, 48567, 25687, 547823, 12464, 22229, 12464, 13815, 12465, 14805, 12464, 22229))"​


qu'il suffit de coller dans le code. On peut ensuite se passer de la feuille Feuil1.

Voir le classeur joint.​


Bonne journée.


ℝOGER2327
#8150

Samedi 21 Sable 143 (Sainte Tape, pompette - fête Suprême Quarte)
30 Frimaire An CCXXIV, 5,8385h - pelle
2015-W52-1T14:00:44Z
 

Pièces jointes

  • Copie de mada.xlsm
    40.2 KB · Affichages: 38
Vote positif 0 Vote négatif
MADAGASCAR

MADAGASCAR

XLDnaute Occasionnel
Re : CODE 500 lignes

Bonjour Caillou
Merci beaucoup pour votre aide et pour votre code
Tres gentil de votre part
La malheure c'est que je veux pas passer par "Feuil1" j'aime bien faire tous ça avec code
Une autre fois merci
Amicalement
MADA BLACK
 

Pièces jointes

  • merci33.gif
    merci33.gif
    79.7 KB · Affichages: 16
  • merci33.gif
    merci33.gif
    79.7 KB · Affichages: 10
Vote positif 0 Vote négatif
MADAGASCAR

MADAGASCAR

XLDnaute Occasionnel
Re : CODE 500 lignes

Bonjour Laetitia90
Merci beaucoup pour votre aide et pour votre code
C'est vraiment de la gentillesse de votre aprt
Trés heureux avec un grand plaisir de vous rencontrer et rencontrer vos formidables codes une autre fois
Ma malheure c'est que je veux pas passer par "Feuil1" j'aime bien faire tous ça avec code
Meme je suis capable d'ecrire 500 lignes mais je serai tres ravi que quelqu'un peut m'aider et les faire un peut moins (100 ou 200 lignes)
Une autre fois merci
Cordialement
MADA BLACK
 

Pièces jointes

  • m2.gif
    m2.gif
    57.7 KB · Affichages: 8
  • m2.gif
    m2.gif
    57.7 KB · Affichages: 16
Vote positif 0 Vote négatif
MADAGASCAR

MADAGASCAR

XLDnaute Occasionnel
Re : CODE 500 lignes

Bonjour Paf
Merci beaucoup pour votre aide et pour votre code
C'est vraiment de la gentillesse de votre part
"il faudra donc écrire en 'dur' dans le code la valeur des différents échelons......"
il me semble que vous m'avez beaucoup approcher de mon désir
Oui d'accord Monsieur Paf.. je suis capable d'ecrire en dur ces punibles lignes
Je vais essayer de l'ecrire
Alors donc je suis pas obligé d'ecrire votre deuxieme code :
Private Sub ComboBox2_Change()
Dim CatEch
CatEch = Range("D5:O21")
TextBox1 = CatEch(ComboBox1.ListIndex + 1, ComboBox2.ListIndex + 1)
End Sub
Cliquez pour agrandir...
Une autre fois merci
Cordialement
MADA BLACK
 

Pièces jointes

  • merci44.gif
    merci44.gif
    89.5 KB · Affichages: 13
  • merci44.gif
    merci44.gif
    89.5 KB · Affichages: 10
Vote positif 0 Vote négatif
MADAGASCAR

MADAGASCAR

XLDnaute Occasionnel
Re : CODE 500 lignes

Bonjour gosselien
Merci beaucoup pour votre idee et remarque
C'est vraiment de la gentillesse de votre part
"il y a une raison particulière à cette affirmation ? "
Ma malheure c'est que je veux pas passer par "Feuil1" j'aime bien faire tous ça avec code
Ma raison particuliere c'est pour raison de securité ..je tenter de faire ce fichier exactement comme VB6 ..fichier exe ..je dis bien je tente ..voila cher gosselien ma raison par franchise
Si vous avez une idee svp dites moi ..
Une autre fois merci
Cordialement
MADA BLACK
 

Pièces jointes

  • m4.jpg
    m4.jpg
    152.3 KB · Affichages: 14
  • m4.jpg
    m4.jpg
    152.3 KB · Affichages: 13
Vote positif 0 Vote négatif
MADAGASCAR

MADAGASCAR

XLDnaute Occasionnel
Re : CODE 500 lignes

Bonjour ROGER2327
Merci beaucoup pour votre aide et pour votre interressant code et magnifique fichier
C'est vraiment de la gentillesse de votre part
De rencontrer des gens qui vous donnent de leur precieux temps et vous aident c'est un grand bienfait et vaste plaisir
Par grans respect "merci 1000 fois"
je vais essayer de faire ..mais ma petite question est ce que je peux supprimer cette partie de code ci dessous..
Private Sub ComboBox2_Change()

If ComboBox1.Value = "1" And ComboBox2.Value = "1" Then
TextBox1.Text = ("9450")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "2" Then
TextBox1.Text = ("9900")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "3" Then
TextBox1.Text = ("10350")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "4" Then
TextBox1.Text = ("10800")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "5" Then
TextBox1.Text = ("11250")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "6" Then
TextBox1.Text = ("11700")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "7" Then
TextBox1.Text = ("12150")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "8" Then
TextBox1.Text = ("12600")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "9" Then
TextBox1.Text = ("13050")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "10" Then
TextBox1.Text = ("13500")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "11" Then
TextBox1.Text = ("13950")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "12" Then
TextBox1.Text = ("14400")



ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "1" Then
TextBox1.Text = ("10350")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "2" Then
TextBox1.Text = ("10845")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "3" Then
TextBox1.Text = ("11340")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "4" Then
TextBox1.Text = ("11835")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "5" Then
TextBox1.Text = ("12330")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "6" Then
TextBox1.Text = ("12825")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "7" Then
TextBox1.Text = ("13320")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "8" Then
TextBox1.Text = ("307")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "9" Then
TextBox1.Text = ("13815")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "10" Then
TextBox1.Text = ("14310")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "11" Then
TextBox1.Text = ("14805")
ElseIf ComboBox1.Value = "2" And ComboBox2.Value = "12" Then
TextBox1.Text = ("15750")



End If
End Sub
Cliquez pour agrandir...
Une autre fois merci
Cordialement
MADA BLACK
 

Pièces jointes

  • m2.gif
    m2.gif
    57.7 KB · Affichages: 16
  • m2.gif
    m2.gif
    57.7 KB · Affichages: 18
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : CODE 500 lignes

Re...


MADAGASCAR à dit:
Bonjour ROGER2327
Merci beaucoup pour votre aide et pour votre interressant code et magnifique fichier
C'est vraiment de la gentillesse de votre part
De rencontrer des gens qui vous donnent de leur precieux temps et vous aident c'est un grand bienfait et vaste plaisir
Par grans respect "merci 1000 fois"
je vais essayer de faire ..mais ma petite question est ce que je peux supprimer cette partie de code ci dessous..

Une autre fois merci
Cordialement
MADA BLACK
Cliquez pour agrandir...
Très heureux que ma contribution vous intéresse. Et félicitations pour le soin que prenez à répondre à tous ceux qui vous répondent.

Oui, vous pouvez supprimer la procédure​
Code: 
Private Sub ComboBox2_Change_()

If ComboBox1.Value = "1" And ComboBox2.Value = "1" Then
TextBox1.Text = ("9450")
ElseIf ComboBox1.Value = "1" And ComboBox2.Value = "2" Then
TextBox1.Text = ("9900")

'etc., etc.

End If
End Sub
J'avais juste écrit Private Sub ComboBox2_Change_() au lieu de Private Sub ComboBox2_Change() (sans le dernier _) pour neutraliser votre code sans l'effacer.​


Bonne soirée.


ℝOGER2327
#8151

Samedi 21 Sable 143 (Sainte Tape, pompette - fête Suprême Quarte)
30 Frimaire An CCXXIV, 7,2352h - pelle
2015-W52-1T17:21:52Z
 
Vote positif 0 Vote négatif
MADAGASCAR

MADAGASCAR

XLDnaute Occasionnel
Re : CODE 500 lignes

Bonsoir ROGER2327
Merci beaucoup pour votre superbe suivi de mon sujet
Je vais prendre votre fichier comme extra solutions
C'est bien compris ..simplement pour bien manipuler et naviguer dans ce fichier est ce qu'on peut aussi le faire par AddItem
simplement pour ces deux lignes comme exemple
Function toto&(cat%, éch%)
toto = Array(, Array(, 9450, 9900, 10350, 10800, 11250, 11700, 12150, 12600, 13050, 13500, 13950, 14400), _
Array(, 10350, 10845, 11340, 11835, 12330, 12825, 13320, 13815, 14310, 14805, 15255, 15750), _
Cliquez pour agrandir...
Merci 1000 fois d'avance pour l'aide
Cordialement
MADA BLACK
 

Pièces jointes

  • t1.gif
    t1.gif
    23 KB · Affichages: 10
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2019 Limiter un code vba que sur 500 lignes
Réponses
2
Affichages
159
ced91300
C
A
  • Résolu(e)
Microsoft 365 Correction d'un code vba
2
Réponses
22
Affichages
779
AD95
A
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Simplifier un code fonctionnel
Réponses
2
Affichages
284
chaelie2015
chaelie2015
petitbuzuc
  • Question
XL 2016 (résolu) fusionner 2 lignes
Réponses
5
Affichages
276
petitbuzuc
petitbuzuc
J
  • Question
Mon code tourne a l'infini et se plante
Réponses
5
Affichages
295
JessK
J
M
  • Résolu(e)
XL 2016 VBA - Traitement de données en fonction de plusieurs critères avec Dictionary
2
Réponses
29
Affichages
995
Mak_tarmak
M
M
  • Résolu(e)
Microsoft 365 Code pour filtrage
Réponses
3
Affichages
403
Marvin57
M
C
  • Question
XL 2013 [VBA]Créer un nombre de ligne en fonction d'un certain nombre de colonne et remplir ces lignes avec certaines valeurs
Réponses
6
Affichages
461
CaptainSalt31
C
R
  • Résolu(e)
Autres Masquer des lignes et colonnes en fonction d'une valeur d'un menu déroulant
Réponses
1
Affichages
135
Romain77144
R
gsx-air
  • Question
Microsoft 365 Code qui ne fonctionne pas sur Excel 365
Réponses
13
Affichages
583
Staple1600
Staple1600

Membres actuellement en ligne

15 membres et 115 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 216
Messages
2 086 344
Membres
103 193
dernier inscrit
tedelio