Recherche programme
bonjour le forum
je fais un essai et j'aimerais trouver un progrmme macro pour remplir un tableau
je joint un bout de fichier avec des explications
merci
Bonsoir,
Dans le fichier joint, clique sur le bouton bleu
J'ai un peu modifié ta façon de récupérer le résultat final.
Je suppose que tu commences en ligne 2, de la colonne B à la colonne F, et que tu récupères les résultats dans la cellule I2 pour les valeurs inférieures à 10, et dans la colonne I13 pour les valeurs supérieures ou égales à 10 et inférieures à 20
A adapter, si tu n'y arrives pas, klaxonnes.....(lol)
Le code :
Sub recap()
Dim Cel As Range
Dim TbloU(1 To 9, 1 To 9)
Dim TbloD(10 To 19, 10 To 19)
Dim DerLig As Long, I As Long
Dim J As Byte
DerLig = Cells(Rows.Count, 2).End(xlUp).Row - 1
For I = 2 To DerLig Step 2
For Each Cel In Cells(I, 2).Resize(1, 5)
If Cel.Value <> "" Then
For J = 2 To 6
Select Case Cel.Value
Case Is < 10
If Cells(I + 1, J).Value < 10 Then
TbloU(Cel, Cells(I + 1, J).Value) = TbloU(Cel, Cells(I + 1, J).Value) + 1
End If
Case Is < 20
If Cells(I + 1, J).Value >= 10 And Cells(I, J).Value < 20 Then _
TbloD(Cel, Cells(I + 1, J).Value) = TbloD(Cel, Cells(I + 1, J).Value) + 1
End Select
Next J
End If
Next Cel
Next I
Range("I2").Resize(9, 9) = Application.Transpose(TbloU)
Range("I13").Resize(10, 10) = Application.Transpose(TbloD)
End Sub
Le fichier :
Bonne nuit
bonjour cousinhub,le forum
merci pour le code,seul petit ennui (de ma faute) je n'ai pas précidé dans mon premier post que la base de donnée s'agrandit tous les jours,la je viens de rajouter une ligne et elle n'est pas prise en compte quand je clique sur le bouton,de plus les couleurs jaune une ligne sur deux ont-elles de l'importance.
merci
Bonsoir,
Effectivement, si tu ne rajoutes qu'une ligne, celle-ci ne sera pas prise en compte, car j'ai compris dans ton énoncé que tu prenais une ligne sur deux, la 1ère pour les valeurs à calculer, et chaque chiffre ou nombre de la 2ème se référant à ces valeurs.
Donc il faut bien 2 lignes par calcul.
Si ce n'est pas ça, explique un peu mieux
PS, la couleur n'a aucune importance
Bon W-E
bonsoir cousinhub,le forum
effectivement les explications ont toujours été mon problème.
il faut effectivement 2 lignes,la premiere pour savoir quel numéro a appelé la deuxieme,c'est pour cela que la derniere ligne de la base ne sert que lorsque une autre ligne est ajouté
1-2-3-4-5
5-6-7-8-9
la 1ére ligne sont les numéros horizontales dans le tableau de gauche,la 2éme ligne est la position des numéros verticales
ainsi le 5 sera comptabilisé en I 6,le 6 en I 7..etc,appelé par le 1(I1),le 5 sera aussi ajouté en J 6,le 6 en J 7 appelé par le 2(J2)
merci
a+
Bonjour,
Donc c'est normal qu'en rajoutant une seule ligne, celle-ci ne soit pas comptabilisée.
Si je comprends bien, il n'y a plus de problème? (dans ta réponse, tu n'avais rajouté qu'une ligne)
Ou alors??????
Bon dimanche
bonjour cousinhub,le forum
hélas non les résultats ne sont pas ceux que je recherche( du a mes mauvaises explications).
Dans le fichier joint j'ai raccourci la base a 5 lignes et j'ai rajouté 2 tableaux en bas qui sont fait manuellement et donnent les bons résultats.
le principe est que la premiere ligne sert pour la deuxieme ligne,la deuxieme ligne sert pour la troisieme ligne la 4 pour la 5 et ainsi de suite.
lorsqu'on a comptabilisé la 2éme ligne,la 1ére ne sert plus dans le calcul,quand la 3éme ligne a été comptabilisé par rapport a la 2éme,la 2éme ne sert plus.
Si on prend qu'une colonne B le 3 a appelé le 2,il y aura 1 d'inscrit a l'intersection du 3 verticale et du 2 horizontal,le B2 ne sert plus
une 3éme cellule est rajouté B4,la c'est le 2 de B3 qui a appelé le 2 de B4,donc 1 en cellule J3,puis 2 en J3,le 2 de B4 a ppelé le 2 de B5,puis 3 en J3 B5->B6
La ligne B6:F6 devra attendre pour etre comptabilisé qu'une autre ligne soit rajouté.
Je ne sais si cela est réalisable et surtout si mes explications ont été claires
merci
Re-,
OK,
Pour ceci, tu enlèves juste le "Step 2" à la ligne :
For I = 2 To DerLig [barrer]Step 2[/barrer]
Ce qui devient :
.....
.....
DerLig = Cells(Rows.Count, 2).End(xlUp).Row - 1
For I = 2 To DerLig
For Each Cel In Cells(I, 2).Resize(1, 5)
.....
.....
Bonne soirée
bonjour cousinhub,le forum
merci pour le progamme,par contre j'ai voulu l'adapter a un autre classeur qui comporte 10 colonnes et 5 tableaux,j'ai donc rajouté
3 autres"Dim",pareil pour les "Case is >" et les "Range (O2)",S'il rempli bien les 2 premiers tableaux pour les autres ce n'est pas pareil.J'ai rajouté une Feuil 2 pour que vous voyez le résultats donnés.
merci
Bonsoir,
Excuse, je m'étais absenté pour déplacement professionnel.....
Tu n'étais pas loin, avec ton code...
J'ai mis le code "correct", ci-dessous, avec les petites erreurs :
Sub essai()
Dim Cel As Range
Dim TbloU(1 To 9, 1 To 9)
Dim TbloD(10 To 19, 10 To 19)
Dim TbloE(20 To 29, 20 To 29)
Dim TbloF(30 To 39, 30 To 39)
Dim TbloG(40 To 49, 40 To 49)
Dim DerLig As Long, I As Long
Dim J As Byte
DerLig = Cells(Rows.Count, 2).End(xlUp).Row - 1
For I = 2 To DerLig
For Each Cel In Cells(I, 2).Resize(1, 10)
If Cel.Value <> "" Then
For J = 2 To 11 'colonne 2 à 11, soit de la colonne B à K
Select Case Cel.Value
Case Is < 10
If Cells(I + 1, J).Value < 10 Then
TbloU(Cel, Cells(I + 1, J).Value) = TbloU(Cel, Cells(I + 1, J).Value) + 1
'ici, tu as oublié le +1
End If
Case Is < 20
If Cells(I + 1, J).Value >= 10 And Cells(I + 1, J).Value < 20 Then _
TbloD(Cel, Cells(I + 1, J).Value) = TbloD(Cel, Cells(I + 1, J).Value) + 1
Case Is < 30
If Cells(I + 1, J).Value >= 20 And Cells(I + 1, J).Value < 30 Then _
TbloE(Cel, Cells(I + 1, J).Value) = TbloE(Cel, Cells(I + 1, J).Value) + 1
Case Is < 40
If Cells(I + 1, J).Value >= 30 And Cells(I + 1, J).Value < 40 Then _
TbloF(Cel, Cells(I + 1, J).Value) = TbloF(Cel, Cells(I + 1, J).Value) + 1
Case Is < 50
If Cells(I + 1, J).Value >= 40 And Cells(I + 1, J).Value < 50 Then _
TbloG(Cel, Cells(I + 1, J).Value) = TbloG(Cel, Cells(I + 1, J).Value) + 1
End Select
Next J
End If
Next Cel
Next I
Range("O2").Resize(9, 9) = Application.Transpose(TbloU)
Range("O13").Resize(9, 9) = Application.Transpose(TbloD) 'ici, le tableau ne fait que 9 lignes sur 9 colonnes
Range("O25").Resize(9, 9) = Application.Transpose(TbloE)
Range("O37").Resize(9, 9) = Application.Transpose(TbloF)
Range("O49").Resize(9, 9) = Application.Transpose(TbloG)
End Sub
Bonne soirée, et bon W-E