Actualité informatique
Test comparatif matériel informatique
Jeux vidéo
Astuces informatique
Vidéo
Télécharger
Services en ligne
Forum informatique
01Business

|-  LOGICIELS


|||-  

RESOLU: Excel: Macro pour ventiler une plage en groupes

 

Ajouter une réponse
 

 
Page photos
 
     
Vider la liste des messages à citer
 
 Page :
1
Auteur
 Sujet :

RESOLU: Excel: Macro pour ventiler une plage en groupes

Prévenir les modérateurs en cas d'abus 
JJ82
jj82
Sur la bonne voie (de 100 à 499 messages postés)
  1. Posté le 25/11/2010 à 08:48:00  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Bonjour à tous,

 J'ai un tableau Excel où je dois "pointer" des combinaisons existantes.
 Ma plage de recherche est H3:AB200 (non classés en ordre croissant).

 Je voudrais,si possible dans une autre feuille à partir de A1, (dans mon exemple j'ai mis sur la même feuille), lister toutes les combinaisons existantes dans les lignes de la plage (sachant qu'une combinaison de 5 nombres donne automatiquement 3 combinaisons de 4, 10 de 3 ou de 2..etc..)

 Dans le listage (les 5 groupes classés en ordre croissant, si possible pour rechercher une combinaison) il n'y a pas de doublon d'une combinaison, son nombre s'incrémente.

 Je joins un petit exemple.

 http://cjoint.com/?0lziUDQrjhd

 Merci de votre aide.
 Bonne journée

 ps: pour la facilité de compréhension, dans mon exemple je n'ai pas mis une ligne contenant 4 ou 5 nombres.

willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 25/11/2010 à 11:57:18  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
:hello:

 on va essayer de ventiler..en novembre pour chasser les feuilles (d'Excel) :lol:

 voici vite fait la macro programmée en direct sur le forum (donc à tester) que tu pourras améliorer.



 Sub combinaisons()
 'willy 25nov 2010

 dim N(20), C(20) As integer

 Range("H3:AB200" ).Select

 ' on mémorise les nombres du Tableau
 For Each cel In Selection
 If IsNumeric(cel) And cel > 0 Then k = k + 1: N(k) = cel.Value
 Next

 'on élimine les doublons
 For i = 1 To k - 1
 For j = i + 1 To k - 1
 If N(i) = N(j) Then N(i) = 0
 Next
 Next

 ' on retient que les nombres >0
 For i = 1 To k
 If N(i) > 0 Then d = d + 1: C(d) = N(i)
 Next


 For i = 1 To Worksheets.Count
 If Sheets(i).Name = "Combinaisons" Then Sheets(i).Delete: Exit For
 Next
 'on crée une feuille nommée combinaisons
 Sheets.Add
 ActiveSheet.Name = "Combinaisons"


 For i = 1 To d : li = li + 1
 Cells(li, 1) = C(i)
 Next

 If d > 1 Then
 li = 0
 For i = 1 To d
 For j = i + 1 To d : li = li + 1
 Cells(li, 3) = C(i)
 Cells(li, 4) = C(j)
 Next
 Next
 End If

 If d > 2 Then
 li = 0
 For i = 1 To d
 For j = i + 1 To d
 For l = j + 1 To d : li = li + 1
 Cells(li, 6) = C(i)
 Cells(li, 7) = C(j)
 Cells(li, 8) = C(l)
 Next
 Next
 Next
 End If

 If d > 3 Then
 li = 0
 For i = 1 To d
 For j = i + 1 To d
 For l = j + 1 To d
 For m = l + 1 To d : li = li + 1
 Cells(li, 10) = C(i)
 Cells(li, 11) = C(j)
 Cells(li, 12) = C(l)
 Cells(li, 13) = C(m)
 Next
 Next
 Next
 Next
 End If

 If d > 4 Then
 li = 0
 For i = 1 To d
 For j = i + 1 To d
 For l = j + 1 To d
 For m = l + 1 To d
 For p = m + 1 To d : li = li + 1
 Cells(li, 15) = C(i)
 Cells(li, 16) = C(j)
 Cells(li, 17) = C(l)
 Cells(li, 18) = C(m)
 Cells(li, 19) = C(p)
 Next
 Next
 Next
 Next
 Next
 End If

 Columns("A:S" ).Select
 Columns("A:S" ).EntireColumn.Au​toFit
 Range("A1" ).Select

 End Sub

 :salut:


---------------
[:ahlefoufou] Merci de sauver les chats abandonnés en aidant cette association : [:tazounet:5]
- Pension MillePattes
(Publicité)
jj82
Sur la bonne voie (de 100 à 499 messages postés)
  1. Posté le 25/11/2010 à 15:42:20  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Bonjour Willy,

 Bravo pour cette rapidité de faire en direct une macro. Pas simple!

 Je joins la macro installée:

 http://cjoint.com/?0lzpK5MBgmb

 Le résultat ne correspond pas quant à la ventilation (ça souffle ...!!) car il y a en résultat des combinaisons à 5 ou 4 nombres, alors que la plus grande combinaison dans ma plage est à 3 nombres?

 On ventile seulement les combinaisons existantes dans la plage.(on n'en crée pas), le but étant de "pointer" ce qui est présent et de voir le nombre.

 Il manque également les nombres pour éviter les doublons des mêmes combinaisons en résultat.
 J'ai surligné en jaune ce qui est "en trop" dans la feuille.

 Quant à l'améliorer ou la compléter, j'en suis incapable (sauf petite retouche, mais là c'est beaucoup plus)
 Merci beaucoup.
 Bonne soirée

willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 25/11/2010 à 18:15:40  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Re,


 J'avais pris tous les nombres affichés dans le tableau pour faire les combinaisons. tu peux modifier la macro pour tester chaque ligne.
 :salut:


---------------
[:ahlefoufou] Merci de sauver les chats abandonnés en aidant cette association : [:tazounet:5]
- Pension MillePattes
jj82
Sur la bonne voie (de 100 à 499 messages postés)
  1. Posté le 25/11/2010 à 18:59:57  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 

 Bonsoir Willy, je connais assez bien les formules mais pas assez les macros pour modifier ce code.
 Si un jour tu as un moment, ça ne presse pas.
 Merci et bonne soirée

(Publicité)
willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 25/11/2010 à 21:42:20  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
ok,
 encore du rapidos: juste pour les lignes 3 à 7 pour essai
 http://www.cijoint.fr/cjlink.p [...] X4c0Sy.xls
 modifie la macro pour ta selection Range("H3:AB200" ).Select

 on peut surement faire plus court.... mais bon ça l'air de fonctionner


 Sub combinaisons()
 'willy 25nov 2010

 Dim N(20), C(20) As Integer

 Range("H3:AB200" ).Select

 nli1 = 0: nli2 = 0: nli3 = 0: nli4 = 0: nli5 = 0

 ' on mémorise les nombres du Tableau
 For Each cel In Selection
 a = a + 1

 If IsNumeric(cel) And cel > 0 Then k = k + 1: N(k) = cel.Value
 If a = 21 Then a = 0: GoTo suite Else GoTo fin

 suite:

 ' on retient que les nombres >0
 d = 0
 For i = 1 To k
 If N(i) > 0 Then d = d + 1: C(d) = N(i): dd = d
 Next
 If d = 0 Then GoTo fin

 k = 0

 If d >= 1 Then
 li1 = nli
 For i = 1 To d : li1 = li1 + 1
 Sheets("Combinaisons" ).Cells(l​i1, 1) = C(i)
 Next
 End If
 nli = li1


 If d >= 2 Then
 li2 = nli2
 For i = 1 To d
 For j = i + 1 To d : li2 = li2 + 1
 Sheets("Combinaisons" ).Cells(l​i2, 3) = C(i)
 Sheets("Combinaisons" ).Cells(l​i2, 4) = C(j)
 Next
 Next
 End If
 nli2 = li2

 If d >= 3 Then

 li3 = nli3
 For i = 1 To d
 For j = i + 1 To d
 For l = j + 1 To d : li3 = li3 + 1
 Sheets("Combinaisons" ).Cells(l​i3, 6) = C(i)
 Sheets("Combinaisons" ).Cells(l​i3, 7) = C(j)
 Sheets("Combinaisons" ).Cells(l​i3, 8) = C(l)
 Next
 Next
 Next
 End If
 nli3 = li3

 If d >= 4 Then
 nli4 = nli4
 For i = 1 To d
 For j = i + 1 To d
 For l = j + 1 To d
 For m = l + 1 To d : li4 = li4 + 1
 Sheets("Combinaisons" ).Cells(l​i4, 10) = C(i)
 Sheets("Combinaisons" ).Cells(l​i4, 11) = C(j)
 Sheets("Combinaisons" ).Cells(l​i4, 12) = C(l)
 Sheets("Combinaisons" ).Cells(l​i4, 13) = C(m)
 Next
 Next
 Next
 Next
 End If
 nli4 = nli4

 If d >= 5 Then
 li5 = nli5
 For i = 1 To d
 For j = i + 1 To d
 For l = j + 1 To d
 For m = l + 1 To d
 For p = m + 1 To d : li = li + 1
 Sheets("Combinaisons" ).Cells(l​i5, 15) = C(i)
 Sheets("Combinaisons" ).Cells(l​i5, 16) = C(j)
 Sheets("Combinaisons" ).Cells(l​i5, 17) = C(l)
 Sheets("Combinaisons" ).Cells(l​i5, 18) = C(m)
 Sheets("Combinaisons" ).Cells(l​i5, 19) = C(p)
 Next
 Next
 Next
 Next
 Next
 End If
 nli5 = nli

 fin:
 Next

 Sheets("Combinaisons" ).Select
 Columns("A:S" ).Select
 Columns("A:S" ).EntireColumn.Au​toFit
 Range("A1" ).Select

 'on supprime les doublons colonne A
 maxi = Range("A1" ).End(xlDown).Row
 If maxi = 65536 Then maxi = 1
 For i = 1 To maxi
 For j = i + 1 To maxi
 If Cells(i, 1) = Cells(j, 1) Then Cells(j, 1).Delete Shift:=xlUp
 Next
 Next


 'on supprime les doublons colonne c,d
 maxi = Range("c1" ).End(xlDown).Row
 If maxi = 65536 Then maxi = 1
 For i = 1 To maxi
 For j = i + 1 To maxi
 If Cells(i, 3) = Cells(j, 3) And Cells(i, 4) = Cells(j, 4) Then Range(Cells(j, 3), Cells(j, 4)).Delete Shift:=xlUp
 Next
 Next

 'on supprime les doublons colonne F,G,H
 maxi = Range("F1" ).End(xlDown).Row
 If maxi = 65536 Then maxi = 1
 For i = 1 To maxi
 For j = i + 1 To maxi
 If Cells(i, 6) = Cells(j, 6) And Cells(i, 7) = Cells(j, 7) And Cells(i, 8) = Cells(j, 8) Then Range(Cells(j, 6), Cells(j, 8)).Delete Shift:=xlUp
 Next
 Next

 'on supprime les doublons colonne F,G,H
 maxi = Range("J1" ).End(xlDown).Row
 If maxi = 65536 Then maxi = 1
 For i = 1 To maxi
 For j = i + 1 To maxi
 If Cells(i, 10) = Cells(j, 10) And Cells(i, 11) = Cells(j, 11) And Cells(i, 12) = Cells(j, 12) And Cells(i, 13) = Cells(j, 13) Then Range(Cells(j, 10), Cells(j, 13)).Delete Shift:=xlUp
 Next
 Next



 End Sub


 :salut:

 j'ai assez ventilé ce jour  :sleep:


---------------
[:ahlefoufou] Merci de sauver les chats abandonnés en aidant cette association : [:tazounet:5]
- Pension MillePattes
jj82
Sur la bonne voie (de 100 à 499 messages postés)
  1. Posté le 26/11/2010 à 09:18:06  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 

 Bonjour Willy et merci pour le code.
 Je le testerai cet AM.
 Tu as raison, assez ventilé pour la journée !
 merci

willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 26/11/2010 à 10:17:49  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 

 

jj82 a écrit :

 
 bonjour willy et merci pour le code.
 je le testerai cet am.
 tu as raison, assez ventilé pour la journée !
 merci

 



 bonjour,
 Pour le service rendu, si tu es généreux ,tu peux faire un don de qq euros à une association des chats abandonnés de la ville de Plaisir.
 (adresse communiquée par messagerie du forum)
 :jap:


---------------
[:ahlefoufou] Merci de sauver les chats abandonnés en aidant cette association : [:tazounet:5]
- Pension MillePattes
(Publicité)
jj82
Sur la bonne voie (de 100 à 499 messages postés)
  1. Posté le 26/11/2010 à 10:18:02  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Willy,

 Juste pour info: (j'utilise des filtres de tri pour les colonnes que la macro à créées)

 La suppression des doublons en colonne A commence puis boucle sur le premier next, sans s'arrêter, alors que des doublons sont encore présents:(par ex le 1 ou le 9 ou le 43  ici):
 22
 20
 4
 21
 23
 27
 29
 1
 11
 15
 9
 38
 46
 33
 7
 16
 39
 24
 49
 31
 43
 43
 16
 38
 49
 9
 7
 43
 31
 24
 33
 39
 46
 1

 Page :
1

Aller à :
 

Sujets relatifs
Excel recherche formule [résolu] Excel: modification plage macro.
les gros fichiers ne passent pas dans utorrent!!! (résolu) Assembler ou diviser des fichiers PDF (RESOLU)
excel : classer les feuilles/résolu pb transfert de code postal d'excel a word
Windows 8 et Ccleaner. [Résolu] Macro sur internet
probleme mon pc ne lit pas ma carte sd (résolu) Quels sont nos groupes ou chanteurs préférés ? ^-^
Plus de sujets relatifs à : RESOLU: Excel: Macro pour ventiler une plage en groupes

Les 5 sujets de discussion précédents Nombre de réponses Dernier message
Comment lire avec word 2000 un doc extension .docx [résolu] 5
WORD Raccourci clavier pour cadre pointillé clignotant 0
Demande aide pour Word 2007 1
WORD 3
quand Word plante tout le reste plante aussi (résolu) 7