Boucle à 2 variable? Résolu/Fermé

Question

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

ddez · Answer

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

Polux31 · Answer

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

lermite222 · Answer

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+

lermite222 · Answer

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

lermite222 · Answer

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.

lermite222 · Answer

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+

lermite222 · Answer

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

Boucle à 2 variable?

7 réponses

Discussions similaires