Sujet Précédent Sujet Suivant

Boucle à 2 variable?

Résolu/Fermé
Pawn - 7 août 2008 à 10:22
 Pawn - 19 août 2008 à 10:13
Bonjour,

je rencontre un problème sur une macro que je viens de crée.
J'ai un 1er classeur de 16 000 lignes et un 2éme de 300 lignes.
Le but est d'extraire les donnée du 2eme vers le Premier via la boucle for (K=2 to Lsce).Pour augmenter la rapidité j'ai penser à mettre une autre boucle for. Probléme, la valeur de j reste à 0
Une idée ? La boucle K pose probléme ?

Merci !

ps : Excel 2003
----------------------------------------------------------------------

Windows("C2.xls").Activate
Sheets("Feuil2").Activate
Range("A2").Select

Lsce = 2
Do
Lsce = Lsce + 1
Loop Until Range("A" & Lsce).Value = Empty
MsgBox (Lsce)


For K = 2 To Lsce

Cells(K, 3).Select
Vcherche = ActiveCell.FormulaR1C1
MsgBox (Vcherche)

If Vcherche = "1" Then
Début = 2
If Vcherche = "2" Then
Début = 100
If Vcherche = "3" Then
Début = 1000
If Vcherche = "4" Then
Début = 2000

End If
End If
End If
End If

Windows("C2.xls").Activate
Sheets("Feuil2").Activate

For j = 2 To ligne
MsgBox (j)
Windows("C1.xls").Activate
Sheets("Feuil1").Activate
Cells(j, 5).Select
Valcherche = ActiveCell.FormulaR1C1

'MsgBox (valeurchercher)
trouve = False
q = 1
Do
Windows("C2.xls").Activate
Sheets("Feuil2").Activate
Cells(q, 1).Select

If Selection.Value = valeurchercher Then
trouve = True
Cells(q, 2).Select
Selection.Copy
Windows("C1.xls").Activate
Sheets("Feuil2").Activate
Cells(j, 7).Select
ActiveSheet.Paste
---------------------------------------------------------
A voir également:

7 réponses

Réponse 1 / 7
ddez
7 août 2008 à 14:02
Ta boucle for n'a pas de fin : 
For K = 2 To Lsce 
...
Next K

D'autre part, ce code ne me semble pas judicieux : 
If Vcherche = "1" Then 
   Début = 2 
   If Vcherche = "2" Then 
      Début = 100 
      If Vcherche = "3" Then 
         Début = 1000 
         If Vcherche = "4" Then 
            Début = 2000 
         End If 
      End If 
   End If 
End If

J'aurai plus vu un truc du genre : 
If Vcherche = "1" Then 
   Début = 2 
End If 
If Vcherche = "2" Then   
   Début = 100 
End If 
If Vcherche = "3" Then 
   Début = 1000 
End If 
If Vcherche = "4" Then 
   Début = 2000 
End If
0
Pawn
7 août 2008 à 15:41
Salut, ça n'a pas servi à grand chose, j'ai été obligé de retirer les End If.
ça doit être dut aux 2 variables.
si je remplace le "Début" par une valeur fixe, sa fonctionne, mais c'est trop long.
trop de ligne ....
0
Pawn
7 août 2008 à 16:40
le Next K se situe a la fin de la Sub
j'ai extrais une partie.
Si je met une valeur a Debut, sa marche bien, mais dés qu'il y a "Début" le "j" reste à 0 et la sub bloque sur

Cells(j, 5).Select
0
ddez > Pawn
7 août 2008 à 16:47
Ha oui ...
Quand on code, on évite au maximum les caractères spéciaux, les accents ...
0
Pawn > ddez
8 août 2008 à 08:59
Salut, j'ai remplacé le "Début" par "n" et le problème reste le même.

j'ai tenté de mettre "Dim n as .... " mais rien ne change. est-ce un mauvais choix de boucle ?

merci pour tes réponses.
0
Réponse 2 / 7
Polux31 Messages postés 6917 Date d'inscription mardi 25 septembre 2007 Statut Membre Dernière intervention 1 novembre 2016 1 204
7 août 2008 à 14:05
bonjour,

Probléme, la valeur de j reste à 0 ... où est initialisé ligne dans For j = 2 to ligne ?

;o)
0
Pawn
7 août 2008 à 15:23
Salut, elle est initialisé par une boucle loop que j'ai mise au dessus du la boucle for

ligne = 1
do
ligne = ligne +1
loop until range("A" & ligne) = empty

il reste à 0 par rapport à la variable "début".
il garde pas en memoire la valeur de la variable, enfin je crois ....

" dim Début as Variant "
0
Réponse 3 / 7
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
8 août 2008 à 10:14
bonjour tous,
Peut-être avec cette tite macro... 
Sub VB12()
Dim K As Long, J As Long
Dim FL1 As Worksheet
Dim FL2 As Worksheet
    Set FL1 = Workbooks("C1.xls").Sheets("Feuil1")
    Set FL2 = Workbooks("C2.xls").Sheets("Feuil2")
    
    For K = 2 To FL1.Range("E65536").End(xlUp).Row
        For J = 2 To FL2.Range("A65536").End(xlUp).Row
            If FL1.Cells(K, 5) = FL2.Cells(J, 1) Then
                FL2.Cells(J, 2).Copy FL1.Cells(K, 7)
                Exit For
            End If
        Next J
    Next K
End Sub

Si j'ai bien compris ce que tu veux faire.
A+
0
Pawn
11 août 2008 à 15:04
SAlut lermit222
Effectivement c'est bien cela, l'ennui, c'est que la macro met du temps avant de se terminer.
Aurais-tu une idée pour augmenter la rapidité de la chose ?

Merci
0
Réponse 4 / 7
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
12 août 2008 à 09:12
Quand tu fait des opérations sur 2 classeurs, ça prend toujours plus de temps ça dépend aussi du nombre de lignes à traiter, dans ton cas il faut tester 16000 x 300 = 4.800.000 lignes !!
Tu peu déjà un peu accélérer en intercalant les lignes ... 
    Set FL2 = Workbooks("C2.xls").Sheets("Feuil2")

    Application.EnableEvents = False 'annule provisoirement les macro qui pourraient-êtres dans les événements de feuilles.
    Application.ScreenUpdating = False ' annule provisoirement la mise à jour de l'affichage.


    For K = 2 To FL1.Range("E65536").End(xlUp).Row

et... 

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
0
Pawn
13 août 2008 à 09:22
Ok je vais essayer ça, pour le coup 16 000 x 300 j'avais bien compris que sa serai long, mais je pensais pas que j'en aurais pour 30 min :s sa me parait toujours énormes.

autre question, quand il y a :

fl1.range("E65536").end(xlUp).row

tu par cours de la derniere ligne à la premiere ?
ou c'est la meme chose qu'une boucle loop qui compte les lignes ?
derniere chose,

sur un des classeur j'ai des nom et prémon les un en dessous des autres,
j'arrive pas a faire
If activecell.value<> ..... alors next K j'ai essayer ac un petit goto, mais il compte toute les lignes....
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
13 août 2008 à 13:51
fl1.range("E65536").end(xlUp).row
Exact, sauf que c'est une fonction Excel VBA et le résultat est pratiquement immédiat.
Pour ta 2ém question, j'ai pas compris.
0
Pawn
13 août 2008 à 16:19
Pour ma 2nd questions, c'est pas très grave, j'en ai une un peu plus interressante à posé avant de cloturer la demande.

Suite à ton petit code, j'ai cherché à mettre en variable le nom d'un fichier.
c'est à dire que FL2 est un classeur renouveller chaque mois avec un nom different.
j'ai tester avec Workbooks.Open:=FP
mais ça ne passe pas as-tu une idée ?

ps : Dim FP as String

Merci
0
Réponse 6 / 7
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
13 août 2008 à 17:36
Dim FP as string
FP= "C:\Répertoir\SousRépertoir\NomFichier.xls" 'Le chemin complet + nom + extention
Workbooks.Open (FP)
et pour sauver c'est
Workbooks(FP).Save 'mais là, le nom et l'extention suffisent.
A+
0
Réponse 7 / 7
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
14 août 2008 à 08:04
Essaie cette macro, elle devrait être sensiblement plus rapide. 
Sub VB12()
Dim K As Long, J As Long, Plage() As String
Dim Cherch As String, Ligne As Long, Lig As Long
Dim FL1 As Worksheet
Dim FL2 As Worksheet

    'annule provisoirement les macro qui pourraient-êtres dans les événements de feuilles.
    Application.EnableEvents = False
    'annule provisoirement la mise à jour de l'affichage.
    Application.ScreenUpdating = False
    
    Set FL1 = Workbooks("C1.xls").Sheets("Feuil1") 'Destination
    Set FL2 = Workbooks("C2.xls").Sheets("Feuil2") 'origine

    Lig = FL2.Range("A65536").End(xlUp).Row
    Ligne = FL1.Range("E65536").End(xlUp).Row
    
    ReDim Plage(2 To Lig)
    For J = 2 To Lig: Plage(J) = FL2.Cells(J, 1): Next
    
    For K = 2 To Ligne
        Cherch = FL1.Cells(K, 5)
        For J = 2 To Lig
            If Cherch = Plage(J) Then
                FL2.Cells(J, 2).Copy FL1.Cells(K, 7)
                Exit For
            End If
        Next J
        DoEvents
    Next K
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Tu dit..
0
Pawn
19 août 2008 à 10:13
Salut,

Je te remercie pour tes services, c'est cool, pas de bug, mes questions sont résolues ^^

A+
0

Discussions similaires

Un seul de mes écouteurs marche. Que faire ?
VM_417 -
vali54 -

4 réponses
Mon pc s'allume et s'éteint en boucle
Jack -
Daniel -

16 réponses
programme qui n'affiche pas le mot secret
EMy.chev -
yg_be -

3 réponses
Redémarrage en boucle Xiamo mi note 10
Microsam -
Noel -

2 réponses
Comment supprimer une conversation Messenger pour les 2 personnes ?
mercidemaider -
sd -

7 réponses