Alleger code For-Next

Hello Tout le monde,

J'ai besoin de vos renseignements car je voudrais alleger mon code pour que ma macro s'execute plus vite (problem classique me direz vous lol) mais je ne sais pas si c est possible.

En gros dans mon projet j ai une liste de mot en colonne A2:A2000 de ma feuille 1 et une autre liste de mot beaucoup plus longue contenant parfois les memes mots en feuille 2 colonne A2:A6000.

Sur cette feuille 2 j'ai egalement une serie de chiffre en colonne C2:C6000.

Ainsi le but de ma macro est que lorsque le mot de la feuille 1 match celui de la feuille 2 alors il faut faire apparaitre le chiffre correspondant en feuille 1 colonne B .

J'ai donc creer un bouton de commande avec une boucle for/next en feuille 1 qui marche mais qui est vraiement longue a l'execution, voici mon code :

Dim NAME1 As Range

Dim NAME2 as Range

Dim cel As Range

Dim NBE As Range

Dim i As Integer

Set NAME1 = Worksheets("Sheet1").Range("A2:A2000") 'la liste de mot en feuille 1

Set NAME2 = Worksheets("Sheet2").Range("A2:A6000") 'la liste de mot en feuille 2

Set NBE = Worksheets("Sheet1").Range("B2:B2000") 'la colonne ou les chiffres doivent apparaitre

For Each cel In NAME2

For i = 1 To 6000

If cel.Value = NAME1.Cells(i).Value Then

NBE.Cells(i).Value = cel.Offset(0, 2).Value

End If

Next i

Next cel

End Sub

Ainsi je voulais savoir si vous connaissez une autre facon de le faire qui serait plus rapide et plus simple? on m'a parle vaguement d'une boucle do-loop ou while-wend mais je ne maitrise pas du tout....??

Please help me

Merci beaucoup,

Hugo

Bonjour Hugo.c

Pourquoi ne pas utiliser tout simplement la fonction : NB.SI()

A+

Salut Hugo-c, BrunoM45,

voici une façon de faire! Un petit bouton rouge... à tester avec ta BDD mais je gage que cela devrait être très rapide!

Private Sub cmdGO_Click()
'
Dim wks As Worksheet
Dim tTab1, tTab2
'
Set wks = Worksheets("Feuil2")
'
iRow1 = Range("A" & Rows.Count).End(xlUp).Row
iRow2 = wks.Range("A" & Rows.Count).End(xlUp).Row
tTab1 = Range("A2:C" & iRow1)
tTab2 = wks.Range("A2:C" & iRow2)
'
For x = 1 To UBound(tTab1)
    For y = 1 To UBound(tTab2)
        If tTab1(x, 1) = tTab2(y, 1) Then
            tTab1(x, 3) = tTab2(y, 3)
            Exit For
        End If
    Next
Next
'
Range("A2:C" & iRow1) = tTab1
'
End Sub

Avec plaisir!

A+

Bonjour,

Avec Find() :

Sub Test()

    Dim NAME1 As Range
    Dim NAME2 As Range
    Dim Cel As Range
    Dim Trouve As Range

    Set NAME1 = Worksheets("Sheet1").Range("A2:A2000") 'la liste de mot en feuille 1
    Set NAME2 = Worksheets("Sheet2").Range("A2:A6000") 'la liste de mot en feuille 2

    For Each Cel In NAME1

        Set Trouve = NAME2.Find(Cel.Value, , xlValues, xlWhole)

        If Not Trouve Is Nothing Then

            Cel.Offset(, 1).Value = Trouve.Offset(, 2).Value

        End If

    Next Cel

End Sub

Bonjour,

Merci beaucoup j'ai pu alleger mon code ca va beaucoup plus vite maintenant.

Au top!