recherche programme

[jad73]

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

[cousinhub]

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 :

Code: Tout sélectionner

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 :

jad73_v1.xlsm

(22.99 Kio) Téléchargé 14 fois

Bonne nuit

[jad73]

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

[cousinhub]

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

[jad73]

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+

[cousinhub]

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

[jad73]

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

[cousinhub]

Re-,

OK,

Pour ceci, tu enlèves juste le "Step 2" à la ligne :

Code: Tout sélectionner

For I = 2 To DerLig Step 2

Ce qui devient :

Code: Tout sélectionner

.....
.....
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

[jad73]

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

[cousinhub]

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 :

Code: Tout sélectionner

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