Boucle à 2 variable?

Résolu

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

Afficher la suite

A voir également:

Boucle for avec deux variables
Downloader for pc - Télécharger - Téléchargement & Transfert
Deux ecran pc - Guide
Comment faire deux colonnes sur word - Guide
Nombre de jours entre deux dates excel - Guide
Idm for mac - Télécharger - Téléchargement & Transfert

7 réponses

Réponse 1 / 7

ddez

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

Pawn

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

Pawn

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

ddez > Pawn

Ha oui ...
Quand on code, on évite au maximum les caractères spéciaux, les accents ...

Pawn > ddez

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.

Réponse 2 / 7

Polux31 Messages postés 6917 Date d'inscription Statut Membre Dernière intervention 1 204

bonjour,

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

;o)

Pawn

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 "

Réponse 3 / 7

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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+

Pawn

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

Réponse 4 / 7

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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

Pawn

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

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

Posez votre question

Réponse 5 / 7

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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.

Pawn

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

Réponse 6 / 7

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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+

Réponse 7 / 7

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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

Pawn

Salut,

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

A+

Discussions similaires

les 2 petits points sur le e ou sur le i

Supprimer conversation messenger pour tout le monde

je ne trouve pas comment faire les accent avec deux petits point ( ö, ü )

Votre réponse

Discussions similaires