Compter, inserer, et copier

Version imprimable

18/07/2013, 17h31
ludovicchapo

1 pièce(s) jointe(s)

Compter, inserer, et copier

Bonjour à tous
J'ai ,dans le cadre d un stage, developpé une macro sur excel 2007, mais étant un débutant en VBA, je sollicite votre aide, ca fait 3 mois que je galère:cry:
J'ai réussi à faire un bout de programme qui marche! mais tres lentement et j'ai une fonction que je n'arrive pas à faire en VBA.
Je mets mon fichier test en piece jointe car c'est assez complexe:

sur la feuil1 j'ai de J2 à J11 des numeros de plan à la suite (ici appelé 1,2,3 etc...)
sur la feuil2 j'ai ces memes numeros de plan dans la colonne D, mais plusieurs fois et dans n'importe quelle ordre. Ils sont rattachés à un indice sur la colonne A.
J essaye de compter combien ce meme numero de la feuil1 colonne J ce retrouve sur la feuil2 colonne D, une fois trouvé combien il y en a
j'insere sur la feuil1 à l'endroit ou j'ai le numero compté autant de ligne que de numero trouve sur le feuil2 et je copie le numero compté. Jusque là ca marche mais d'une lenteur....

Puis je doit y inserer les indices correspondant(present sur la feuil2 en A) en E dans la feuil1, naturellement en face du bon numero!! mais par contre les indices sont toujours du plus petit au plus grand!!! et ca j'ai pas réussi!!!
Le programme que j'ai pondu est tres moche mais je connais pas les subtilités du VBA je sais juste calculer.
Il y a des copies auto en plus qui marche tres bien mais qui ne font pas partie de l'aide que je demande
Je sollicite votre aide, si vous avez le courage de lire mon post et de regarder mon fichier
Merci à vous!!!!
18/07/2013, 17h37
EngueEngue

Trois mois pour ça ? Tu dois leur couter cher mon ami.

Alors ce que tu demandes a l'air assez simple, mais trop compliqué à comprendre avec de mauvaises explications met un fichier de départ avec tes données brutes et un fichier d'arrivée avec ce que tu veux.

Alors pour faire simple:

D'abord tu tries la feuille 2 par colonne A Puis par D

Maintenant tu boucles et tu comptes et tu as trouvé ton chiffre... ou alors un nb.si ferait aussi bien l'affaire.
Puis après il suffit d'insérer ce que tu veux en bouclant.

Bonsoir,

Si tu veux vraiment du Vba, ci-dessous de quoi executer ton debut de code

Citation:

sur la feuil1 j'ai de J2 à J11 des numeros de plan à la suite (ici appelé 1,2,3 etc...)
sur la feuil2 j'ai ces memes numeros de plan dans la colonne D, mais plusieurs fois et dans n'importe quelle ordre. Ils sont rattachés à un indice sur la colonne A.
J essaye de compter combien ce meme numero de la feuil1 colonne J ce retrouve sur la feuil2 colonne D, une fois trouvé combien il y en a
j'insere sur la feuil1 à l'endroit ou j'ai le numero compté autant de ligne que de numero trouve sur le feuil2 et je copie le numero compté. Jusque là ca marche mais d'une lenteur....
Code:

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 debutcode() Dim Plage1 As Range, Cel As Range, tbl() Dim x As Long Dim i As Long Dim DernLigne As Long i = 0 With Sheets("feuil1") DernLigne = .Range("J" & .Rows.Count).End(xlUp).Row For x = DernLigne To 2 Step -1 If IsEmpty(Range("J" & x)) Then .Range("J" & x).EntireRow.Delete End If Next x DernLigne = .Range("J" & .Rows.Count).End(xlUp).Row ReDim Preserve tbl(1 To DernLigne - 1) Set Plage1 = .Range("J2:J" & DernLigne) End With With Sheets("Feuil2") DernLigne = .Range("D" & .Rows.Count).End(xlUp).Row For Each Cel In Plage1 'calcul du nombre de cellules J$ de la plage2 identique à D$ dans la plage1 i = i + 1 tbl(i) = WorksheetFunction.CountIf(.Range("D1:D" & DernLigne), Cel.Value) Next Cel End With With Sheets("Feuil1") DernLigne = .Range("J" & .Rows.Count).End(xlUp).Row For i = DernLigne To 2 Step -1 .Rows(i).Resize(tbl(i - 1)).Insert Next i End With End Sub
si ça t'aide et si ça te va, essaies d'analyser afin de pouvoir poursuivre
Bien sur, ma proposition n'est pas parfaite, loin de là, mais je pense que c'est un début de piste

Ajout (à 3h10 du matin) :
Je ne suis pas sur d'avoir compris la 2ème partie

Citation:

Puis je doit y inserer les indices correspondant(present sur la feuil2 en A) en E dans la feuil1, naturellement en face du bon numero!! mais par contre les indices sont toujours du plus petit au plus grand!

mais tu peux tester ce code complet :
Code:

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 34 35 36 37 38 39 40 41 42 43 44 45 Sub debutcode() Dim Plage1 As Range, Cel As Range, tbl() Dim x As Long, i As Long, DernLigne As Long Dim tbF2, TBindice() i = 0 With Sheets("feuil1") DernLigne = .Range("J" & .Rows.Count).End(xlUp).Row For x = DernLigne To 2 Step -1 If IsEmpty(Range("J" & x)) Then .Range("J" & x).EntireRow.Delete End If Next x DernLigne = .Range("J" & .Rows.Count).End(xlUp).Row ReDim Preserve tbl(1 To DernLigne - 1) Set Plage1 = .Range("J2:J" & DernLigne) End With With Sheets("Feuil2") DernLigne = .Range("D" & .Rows.Count).End(xlUp).Row For Each Cel In Plage1 'calcul du nombre de cellules J$ de la plage2 identique à D$ dans la plage1 i = i + 1 tbl(i) = WorksheetFunction.CountIf(.Range("D1:D" & DernLigne), Cel.Value) Next Cel tbF2 = .Range("A1:D" & DernLigne) End With With Sheets("Feuil1") DernLigne = .Range("J" & .Rows.Count).End(xlUp).Row For i = DernLigne To 2 Step -1 .Rows(i).Resize(tbl(i - 1)).Insert Next i x = 0 For Each Cel In Plage1 For i = 1 To UBound(tbF2, 1) If Cel = tbF2(i, 4) Then x = x + 1 ReDim Preserve TBindice(1 To x) TBindice(x) = tbF2(i, 1) End If Next i Next Cel .Range("A2:A" & UBound(TBindice)) = WorksheetFunction.Transpose(TBindice) End With End Sub
Bon courage

19/07/2013, 09h45
ludovicchapo

1 pièce(s) jointe(s)

Merci à vous, d'avoir repondu aussi vite!!!:)

Sinon en trois mois heureusement que je n'ai pas fais que ca!! en faite je suis en stage en dessin industriel en bureau d'étude/méthode et l'info c'est juste pour m'aider dans mon organisation de travail, alors avant de commencer le stage je savais même pas que les macros d'excel c'était du vba!! Et en gros à par exception les programmes info je le fais chez moi pas le temps au taf!!, donc tkt je ne dois pas couter trop cher à 430E/ mois ;)
Allez un bon vendredi à regarder tout ca sous 30° à l'hombre
à plus

Merci

Bonjour à toi
Merci de repondre aussi vite!!!:P
Bon c'est vrais que mes explications sont pas tres clair, voici en pièce jointe les fichiers debut et arrivé
Vois si tu comprends mon probleme : je veux que ca aille plus vite car en réalité le fichier n'est qu'un test ca doit marcher sur un fichier avec plus de 50000 lignes de N° de plans. Ici je fais le test avec 10 plans (feuil1 colonne J) qui ont plusieurs indices (feuil2 colonne D et A(indice))et ca met deja 15 secondes!!!!!:cry:
Merci d'avance
Ludo

Code:

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
34
35
36
37
38
39
Sub trietcopie()
Dim i as long
  Application.screenupdating=false
    Columns("A:E").Select
    ActiveWorkbook.Worksheets("Feuil2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil2").Sort.SortFields.Add Key:=Range("A1:A34") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil2").Sort
        .SetRange Range("A1:E34")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Feuil2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil2").Sort.SortFields.Add Key:=Range("D1:D34") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil2").Sort
        .SetRange Range("A1:E34")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
 
 
    For i = 1 To Feuil2.Range("A" & Rows.Count).End(xlUp).Row
    Feuil1.Range("J" & i + 1) = Feuil2.Range("D" & i)
    Feuil1.Range("E" & i + 1) = Feuil2.Range("A" & i)
    Feuil1.Range("G" & i + 1) = Feuil2.Range("E" & i)
    Feuil1.Range("S" & i + 1) = Feuil2.Range("B" & i)
    Feuil1.Range("T" & i + 1) = Feuil2.Range("C" & i)
    Next i
 
  Application.screenupdating=true
End Sub

0,004 secondes avec ton fichier

19/07/2013, 10h50
ludovicchapo

1 pièce(s) jointe(s)

CA MARCHE PRESQUE

Salut Dom
merci pour ton aide:D
J'ai essayé et c'est presque ca!! ca doit etre mon explication qui est de mauvaise qualité loin de la de penser que ce que tu m as fais ne marche pas.
J'ai mis en piece jointe le fichier (fichier debut) avec ton code et son resultat et le deuxieme fichier (fichier resultat) avec mon code et le resultat que je cherche à avoir, et le fichier source avant macro (fichier source)
Je vais essayer de modifier ton code pour l'adapter si j'arrive!!(je comprend pas tout), mais si tu as le temps de comprendre mon probleme et de m'aider ca serait treeeeees cool
Merci d'avance
Ludo

Ecoute tu selectionnes ton tableau en feuille 2 tu le tries par colonne A, puis par colonne D.

Puis tu executes ce code
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub classement() Dim i as long Application.screenupdating=false For i = 1 To Feuil2.Range("A" & Rows.Count).End(xlUp).Row Feuil1.Range("J" & i + 1) = Feuil2.Range("D" & i) Feuil1.Range("E" & i + 1) = Feuil2.Range("A" & i) Feuil1.Range("G" & i + 1) = Feuil2.Range("E" & i) Feuil1.Range("S" & i + 1) = Feuil2.Range("B" & i) Feuil1.Range("T" & i + 1) = Feuil2.Range("C" & i) Next i Application.screenupdating=true End Sub
Citation:

Envoyé par ludovicchapo

temps de comprendre mon probleme
Ludo

Ton problème est faisable en dix secondes sans macro... donc bon.. Ne cherche pas à compliquer les choses mais simplifie les

19/07/2013, 11h15
ludovicchapo

Bon ba j'ai rien à dire vous étes trop fort et surtout super réactif
MERCI CA MARCHE:ccool:
il reste des petites choses à ameliorer mais c'était pas dans mes explication
je vais quand même essayer de le finir par moi même mais si j'arrive pas je pourrais vous resoliciter?
Cordialement
Ludo

je pense que je suis obligé de faire avec une macro, car il ne suffit pas que de trier et copier mais si le plan ne figure pas en feuil1 colonne J il ne doit pas le copier et n'y inserer les données qui vont avec de plus il peut y avoir des modif en cours de vie du fichier source feuil2, et il fait parti d'un autre fichier avec d'autre macro.
De plus ce fichier doit etre consultable sans y toucher la moindre fonction d'excel tout en auto, voila en tout cas merci,
et je pense à tres bientot quand je rebuggerais
19/07/2013, 11h20
EngueEngue

il te suffira de faire une boucle et de virer les colonnes superflues.
Bon courage
19/07/2013, 12h45
ludovicchapo

1 pièce(s) jointe(s)

En faite ca marche pas comme je veux

ReBonjour,
Bon je dois pas etre tres bon en explication mais comme vous etes doué, je réessaye de correctement expliquer ou plus en detail:
J'ai fais une erreure en metant des chiffres dans l'ordre dans la feuil1 colonne J, car en faite il n'y a pas d'ordre à respecter que celle ecrite en feuil1 colonne J (ca a pu induire en erreur) on peut considerer que c'est du texte.
La feuil2 est une base de donnée qui evolue mais qui comprend bcp plus de numero de plan environ 50000(colonne D) que dans la feuil2 environ 200, seul les numero de plan de la feuil1, avant la macro, doivent etre present apres la macro mais avec des insertions de lignes et des copies si on en retrouve plusieurs sur la feuil2.

Exemple :
Si j'ai un numero de plan dans la feuil1 il va rechercher dans la feuil2 le nombre de numero correspondant.

Si il en trouve 4 il va inserer 3 lignes en dessous ou dessus du numero cherché en feuil1 et il copie le numero dans les cellules crée vide (pour avoir le meme nombre de numero de plan dans la feuil1 et dans la feuil2), puis il copie la cellule A(l'indice) correspondant au numero de plan de la feuil2 dans la feuil1 sur la même ligne que le plan correspondant(peu importe la colonne de destination)

Si il en trouve autant dans la feuil1 que dans la feuil2 (des numero de plan) il copie simplement l'indice ou les indices correspondants

Si il en trouve moins dans la feuil2 que dans la feuil1 il supprime celui en trop

Je mets les deux fichiers en pieces jointes le fichier XXXxlsm pour visualiser avant la macro et le fichier XXXRESULTAT apres la macro.

Ma macro donne le bon resultat mais c'est trop lent et il ne gere pas la copie des indices (dans ma macro je triche)

Voila encore merci pour l'aide que vous pouvez m'apporter!!

Ludo
19/07/2013, 13h22
EngueEngue

Tu as vraiment envie d'insérer des lignes toi hein!

Alors voilà comment je vois les choses:
-Le double tri comme je t'ai expliqué
-La macro de copie
-Par la suite réordonner les lignes dans l'ordre que tu veux en supprimant les inutiles.

Excuses-moi EngueEngue mais comme j'ai préparé un code, je le soumets à ludovicchapo

Code:

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
34
35
36
37
38
39
40
Sub SumProductSimul()
' compte tenu de tes 50000 lignes, je passe tout par variable tableau
Dim x As Long, y As Long, DernLigne As Long, Id As Long
Dim TBindice, TbOriGine, Tbresultat()
Id = 0 'j'initialise Id
With Sheets("feuil1")
  DernLigne = .Range("J" & .Rows.Count).End(xlUp).Row
  TbOriGine = .Range("J2:J" & DernLigne) '1er tableau de feuil1
  .Rows(2 & ":" & DernLigne).Delete 'je supprime toutes les données de feuil1
End With
'**************************************
'ci-dessous, je parcoure le 1er tableau pour enlever les vides
For x = UBound(TbOriGine) To 1 Step -1
  If TbOriGine(x, 1) = "" Then
    ReDim Preserve TbOriGine(1 To UBound(TbOriGine) - 1)
  End If
Next x
'*******************************
'ci-dessous je compare les données et les affectent à un nouveau tableau "Tbresultat"
With Sheets("Feuil2")
  DernLigne = .Range("D" & .Rows.Count).End(xlUp).Row
  TBindice = .Range("A1:D" & DernLigne) '2eme tableau de feuil2, données à comparer
  ReDim Tbresultat(1 To UBound(TBindice, 1), 1 To 6)
  For x = 1 To UBound(TbOriGine, 1)
    For y = 1 To UBound(TBindice, 1)
      If TBindice(y, 4) = TbOriGine(x, 1) Then
        Id = Id + 1
        Tbresultat(Id, 1) = TBindice(y, 1)
        Tbresultat(Id, 6) = TBindice(y, 4)
      End If
    Next y
  Next x
End With
'***********************************
'ci-dessous, j 'affecte le résultat à feuil1 à partir de la colonne E, d'après ton exemple
With Sheets("Feuil1")
  .Range("E2").Resize(UBound(Tbresultat, 1), 6) = Tbresultat
End With
 
End Sub

19/07/2013, 13h45
EngueEngue

Pas besoin de t'excuser, Bravo je n'aurais pas fait mieux!
19/07/2013, 14h03
casefayere

Merci EngueEngue
mais j'espère que ça pourra le satisfaire, je n'ai pas fait d'essai sur 50000 lignes pour controler le temps d'execution

bonne journée
19/07/2013, 14h24
ludovicchapo

TRES BIEN MAIS J AI ENCORE DEUX petits BUGG

C'est pas mal !!! c'est même tres bien,
J'ai quand même 2 petits souci, si j'ai deux fois (et ca peu arriver) le même numero de plan en feuil1 apres une premiere actualisation il met deux fois les resultats
J'ai trouvé une parade un rajoutant la suppression des doublons en VBA
Mais le probleme de ce fichier c'est qu'il se réactualise régulièrement en fonction des nouveaux numero de plans rajouté entre temps et il me met un message d'erreur quand je le relance et il efface les données
ca marche une fois mais pas deux
Si tu vois une solution?
Merci à vous
Désolé de vous solicité autant que ca
Ludo
19/07/2013, 14h52
casefayere

Ca devient compliqué ton histoire, j'ai des courses à faire (eh oui, j'ai une vie), je verrai quand je serai disponible si, bien sur j'arrive à comprendre et interpréter ta nouvelle problèmatique
19/07/2013, 15h19
ludovicchapo

pas simple

Oui c'est vrai c'est un peu compliqué mon histoire, merci pour le temps que t y a passé, en faite c'est pour un autre fichier excel avec pleins d'autres données, je finalise à ma facon mon gros fichier ce week end,
et si à tout hazard tu pourra y regarder la semaine prochaine tu comprendra mieux mon probleme il est trop long à actualiser!!
J'ai un fichier excel avec 5 feuilles sources de données qui s'actualise toutes les 15min via un ERP et une feuille qu'on consulte qui met toutes les données dans un shaker et apres secousse il sort des données qui m'interesse mais voila 25min d'acualisation la loose.
Tout ca à cause des lignes que j'insere, mais je comprend pas les tables en VBA je comprend que la logique de base et encore ... mais j'arrive!!!
Merki
Ludo je desespere pas !!!!
19/07/2013, 15h21
EngueEngue

Alors pour ton souci des 2 fois.. Il suffit de virer les numéros en double avant de commencer le traitement.

Pour ta problématique il suffit de copier ta liste dans une nouvelle page et la récupérer avant le traitement pour réinitialiser à 0