-----Message d'origine----- Insérer une Feuil4 dans le Classeur Supposé 1500lignes peut-être changé Dans module VBA insérer la procedure suivante:
Sub IntersecTFeuill() myc = 1 For Each c In _ Worksheets("Feuil1").Range("a1:a1500").Cells
For Each d In _ Worksheets("Feuil2").Range("A1:A1500").Cells If c.Value = d.Value Then
Worksheets("Feuil1").Rows(c.Row).Copy _ Destination:=Worksheets("Feuil4").Cells(myc, 1) myc = myc + 1 Else End If Next d Next c End Sub
Cordialement LeSteph
.
LeSteph
Effectivement j'avais testé avec 20x20 impec! tandis que 1500x1500 interminable! voici pour un peu plus raisonnable 150x150 on peut suivre l'execution dans la barre d'etat.
Sub IntersecTFeuill() Application.ScreenUpdating = False On Error GoTo sortie myc = 1 mpci = 1
For Each c In _ Worksheets("Feuil1").Range("a1:a150").Cells
For Each d In _ Worksheets("Feuil2").Range("A1:A150").Cells If c.Value = d.Value Then
Worksheets("Feuil1").Rows(c.Row).Copy _ Destination:=Worksheets("Feuil4").Cells(myc, 1) myc = myc + 1 Else End If Application.StatusBar = "Execution de " & mpci mpci = mpci + 1
Next d
Next c
sortie: Application.ScreenUpdating = True Application.StatusBar = False End Sub
Cordialement LeSteph
.
Effectivement j'avais testé avec 20x20 impec!
tandis que 1500x1500 interminable!
voici pour un peu plus raisonnable 150x150
on peut suivre l'execution dans la barre d'etat.
Sub IntersecTFeuill()
Application.ScreenUpdating = False
On Error GoTo sortie
myc = 1
mpci = 1
For Each c In _
Worksheets("Feuil1").Range("a1:a150").Cells
For Each d In _
Worksheets("Feuil2").Range("A1:A150").Cells
If c.Value = d.Value Then
Worksheets("Feuil1").Rows(c.Row).Copy _
Destination:=Worksheets("Feuil4").Cells(myc, 1)
myc = myc + 1
Else
End If
Application.StatusBar = "Execution de " & mpci
mpci = mpci + 1
Next d
Next c
sortie:
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Effectivement j'avais testé avec 20x20 impec! tandis que 1500x1500 interminable! voici pour un peu plus raisonnable 150x150 on peut suivre l'execution dans la barre d'etat.
Sub IntersecTFeuill() Application.ScreenUpdating = False On Error GoTo sortie myc = 1 mpci = 1
For Each c In _ Worksheets("Feuil1").Range("a1:a150").Cells
For Each d In _ Worksheets("Feuil2").Range("A1:A150").Cells If c.Value = d.Value Then
Worksheets("Feuil1").Rows(c.Row).Copy _ Destination:=Worksheets("Feuil4").Cells(myc, 1) myc = myc + 1 Else End If Application.StatusBar = "Execution de " & mpci mpci = mpci + 1
Next d
Next c
sortie: Application.ScreenUpdating = True Application.StatusBar = False End Sub
Cordialement LeSteph
.
LeSteph
Pour accélérer considérablement mais à condition qu'une seule occurrence commune soit prévue: ajouter exit for dans la boucle interne entre ces deux lignes, ici:
myc = myc + 1 Exit For
Else
Cordialement LeSteph
.
Pour accélérer considérablement mais
à condition qu'une seule occurrence commune
soit prévue: ajouter exit for dans la boucle interne
entre ces deux lignes, ici:
Pour accélérer considérablement mais à condition qu'une seule occurrence commune soit prévue: ajouter exit for dans la boucle interne entre ces deux lignes, ici:
