Discussion :

[manitou83]

Bonjour à tous et à toutes,

j'ai beau avoir cherché depuis ce matin mais je ne trouve pas de solutions à mon problème:
Je dois trier des numeros ( sous VBA pour mettre à jour plus simplement)de documents suivant le numero de contrat s'y rattachant, en sachant qu'un contrat peut avoir plusieurs documents

A	B	C	D	E	F	G
DOCUMENT1	LIBELLE	DATE	SYSTEME	CONTRAT1	CONTRAT2	CONTRAT3
doc5223	machine manu	24/02/2014	SMTPP	AK123456	BK123456	CK123456
doc1234	machine manu	24/02/2014	SMTPP	BK123456	CK123456	AK123456
doc5523	machine manu	24/02/2014	SMTPP	AK123456	CK123456	BK123456

Ce que je compte faire est de répertorier tout les documents suivant le contrat. c'est à dire par exemple tout les documents sous le contrat CK123456, et d'avoir un tableau sous cette forme:

A	B	C	D	E	F	G
CONTRAT1	LIBELLE	DATE	SYSTEME	DOCUMENT1	DOCUMENT2	DOCUMENT3
AK123456	machine manu	24/02/2014	SMTPP	doc5223	doc5523	doc1234
BK123456	machine manu	24/02/2014	SMTPP	doc1234	doc5223	doc5523
CK123456	machine manu	24/02/2014	SMTPP2	doc1234	doc5523	doc5223

Une fois le tableau sous cette forme, je voudrai mettre les numeros de documents sur deux lignes et recopier la totalité de la ligne ( en insérant un ligne peut-être?)

A	B	C	D	E	F
CONTRAT1	LIBELLE	DATE	SYSTEME	DOCUMENT
AK123456	machine manu	24/02/2014	SMTPP	doc5223
AK123456	machine manu	24/02/2014	SMTPP	doc5523
AK123456	machine manu	24/02/2014	SMTPP	doc1234
BK123456	machine manu	24/02/2014	SMTPP	doc1234
BK123456	machine manu	24/02/2014	SMTPP	doc5223
BK123456	machine manu	24/02/2014	SMTPP	doc5523
CK123456	machine manu	24/02/2014	SMTPP2	doc1234
CK123456	machine manu	24/02/2014	SMTPP2	doc5523
CK123456	machine manu	24/02/2014	SMTPP2	doc5223

Pour (enfin! ) arriver à un tableau de cette forme ( et avoir une liste de documents triée suivant le numéro de contrat):

A	B	C	D	E
CONTRAT1	LIBELLE	DATE	SYSTEME	DOCUMENT
AK123456	machine manu	24/02/2014	SMTPP	doc5223
	machine manu	24/02/2014	SMTPP	doc5523
	machine manu	24/02/2014	SMTPP	doc1234
BK123456	machine manu	24/02/2014	SMTPP	doc1234
	machine manu	24/02/2014	SMTPP	doc5223
	machine manu	24/02/2014	SMTPP	doc5523
CK123456	machine manu	24/02/2014	SMTPP2	doc1234
	machine manu	24/02/2014	SMTPP2	doc5523
	machine manu	24/02/2014	SMTPP2	doc5223

Maintenant passons au plus tendu : le code...

Je pensais tout d'abords parcourir les cellules des colonnes E à G, inserer une nouvelle ligne et copier la ligne associée au document pour avoir une ligne par documents

A	B	C	D	E	F	G
CK123456	machine manu	24/02/2014	SMTPP2	doc1234
	machine manu	24/02/2014	SMTPP2	doc5523
	machine manu	24/02/2014	SMTPP2	doc5223

Pour ensuite pouvoir trier mes documents suivant les contrats (col A)....

Si quelqu'un aurait une idée ou un exemple de code sur lequel je pourrai m'appuyer pour avancer ce serait vraiment super....

Merci d'avance pour votre aide éventuelle

Cdlt

[anonymous9]

Bonsoir,

Je pense vu ce que tu souhaites faire, qu'un tableau croisée dynamique est adapté.

[manitou83]

Bonjour,

Merci pour ta réponse mais il me semble qu'avec un tableau dynamique je n'aurai que le nombre de DDM par contrat.. et il ya aussi le probleme que mais contrat se trouvent sur plusieurs colonnes/ligne et donc que je ne puissent pas faire un tric "Doc" selon "contrat"... A moins que tu ai une idée? ( je n'utilise pas souvent les tableau dynamique, je ne connais donc pas tous leurs pouvoirs )

Sinon j'ai avancé sur mon code, maintenant jje peux insérer des lignes suivant le nombre de cellules "contrat" non vide, seulement je n'arrive pas encore à déplacer mon curseur "boucle FOR" pour acceder au doc suivant et ainsi recommencer l'opération...le problème viens surement de ma première boucle FOR, (avec le i) qui ne prends pas en compte les nouvelles lignes ajouter lors de la 2eme boucle for "j".

Si vous avez des idées je suis preneur...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub transpocoloumn()
 
Windows("exemple tableau .xlsm").Activate
Worksheets("Feuil3").Select
Dim NB1 As Integer
 
NBl = Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Rows.Count   'calcul  ligne du tableau
 
 ' premier boucle pour se deplacer dans le tableau et parcourir toutes les lignes
 For i = 2 + K To NBl + K ' le K perme tde mettre a jour le nombre de ligne et de déplacer le debut de la boucle
 
 
    nbcells = WorksheetFunction.CountA(Range(Cells(i, 6), Cells(i, 9))) ' compte le nombre de cellule non vide dans la ligne '
 
'boucle pour ajouter une ligne
            For j = 0 To nbcells - 2
 
               Range(Cells(i + j, 1), Cells(i + j, 9)).Select
 
               Cells(ActiveCell.Row + 1, 2).Select
               Selection.EntireRow.Insert
               Range(Cells(i + j, 1), Cells(i + j, 4)).Select
               Selection.Copy   'copie element de la ligne supp
               Range(Cells(i + j + 1, 1), Cells(i + j + 1, 4)).Select
               Selection.PasteSpecial   ' colle elements de la lgine supp
               K = (K + 1)
               Next j
'
              Next i
 
 
 
End Sub

[anonymous9]

Bonsoir,

désolé pour le temps, mais je n'ai pas pu répondre avant.

Ci joint un exemple de ton cas, par contre il est possible de créer deux TCD en lien direct qui approndie plus les recherches. Tout dépend ce que tu souhaites faire, car faire la fin de ton exposé je n'ai pas tout compris.

Cordialement

[Marc-L]

Bonjour manitou83,

j'ai du mal à suivre avec tes multiples tableaux,
as-tu voulu expliquer ta démarche ou les intermédiaires sont-ils forcément nécessaires ?

Sinon il serait plus simple de joindre un classeur en pièce jointe (xls ou xlsx) avec une feuille source et une feuille résultat
et de préciser si les données sources doivent être remplacées ou sinon la destination de la réorganisation …

[Marc-L]

et de préciser si les données sources doivent être remplacées ou sinon la destination de la réorganisation …

Au moins quatre méthodes possibles, donc sans une présentation complète, je ne saurais choisir …

Et cela peut dépendre aussi de la version d'Excel (pas indiquée dans le titre de la discussion ‼) et de celle de Windows …

Et si la feuille source dans le classeur joint n'est pas l'exact reflet du classeur de travail, cela ne va pas le faire !
Le tableau commence bien en ligne n°2 sinon joindre un classeur avec une feuille source identique et une feuille résultat …

Au passage, ce n'est pas le bon forum pour le VBA, le forum dédié est Macros et VBA Excel,
il y aurait peut-être eu plus de réponses …

[manitou83]

Merci Marc-L de ta réponse rapide .

Concernant ma version d'excel c'est la 2007 avec windows Vista.

Non, les données sources ne doivent pas être remplacé, c'est juste une réorganisation du tableau actuel (ajout de ligne, copie de la ligne et trie par rapport au " contrat")
malheureusement, je ne peux pas charger mon tableau de travail, c'est un doc interne....

Mais si tu as un exemple de méthode qui marche sur le tableau que j'ai chargé juste avant, je pourrai adapter la macro à mon tableau de travail (comme ca j'aurai une base pour faire mon trie)


Cordialement

[Marc-L]

Pas besoin de donner dans le pointu ni dans le performant alors, cela reste basique;
à partir du classeur joint tel quel, matrice générée par l'Enregistreur de macros, one shot code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Macro1()
    [A8].Select:  Selection.Clear:  L& = 9
 
    With [A9].CurrentRegion
        If .Rows.Count > 1 Then .Offset(1).Resize(.Rows.Count - 1).Clear
    End With
 
    With [A1].CurrentRegion
        For R& = 3 To .Rows.Count
            For C& = 5 To .Columns.Count
                L = L + 1
                .Cells(R, C).Copy Cells(L, 1)
                .Cells(R, 2).Resize(, 3).Copy Cells(L, 2)
                .Cells(R, 1).Copy Cells(L, 5)
            Next C
        Next R
    End With
 
    With [A9].CurrentRegion
        .Sort .Cells(1), xlAscending, Header:=xlYes
 
        For R& = .Rows.Count To 3 Step -1
            If .Cells(R, 1).Value = .Cells(R - 1, 1).Value Then .Cells(R, 1).ClearContents
        Next
    End With
End Sub

_______________ ____________________________________ ______________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[manitou83]

Salut!

ah parfait!! et bien voila c'est exactement ça que je recherché!
Je vous remercie pour vos réponse, ça m'a vraiment aidé!

Bonne journée!

[Marc-L]

Rechercher une solution sur le net - sport favori des rois du Copier / Coller sans griller deux neurones - est une perte
de temps incroyable car, afin d'aboutir face à ce genre de problème, il suffit juste de réfléchir un tant soit peu !

Office étant doté d'une aide intégrée VBA ainsi d'un Enregistreur de macros, cela permet de bien défricher le terrain …