utilisation d'une boucle qui ne fonctionne pas

**sharox** · 20/11/2013, 14h38

Bonjour a toutes, Bonjour a tous

Voila j'expose mon problème, donc j'ai fait un programme( avec de l'aide)
je vais pas rentrer dans les détailles du code actuelle a part si quelqu'un me le demande.
Ce programme fonctionne très bien je suis content mais comme d'habitude il y a des modifications qui font tout planter

Je voudrait intégrer une boucle exemple (For i = 11 To 81 Step 5)
mais cela ne fonctionne pas et je ne sais pas pourquoi.
Je suppose que l'erreur vient de cette ligne :

Set rngArticle = myWs.Range(myWs.Range(Cells(4, i)), myWs.Range(Cells(65536, i)).End(xlUp))

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub CommandButton4_Click()
 
    MsgBox "ATTENTION, cela peu prendre un peu de temps, veuillez attendre sagement"
    Sheets("feuille_de_prix").Select
'For i = 11 To 81 Step 5  
'ICI L'INITIALISATION DE LA BOUCLE 
    Dim rngArticle As Range
    Dim myWs As Worksheet
    Set myWs = ThisWorkbook.ActiveSheet
    Set rngArticle = myWs.Range(myWs.Range("K4"), myWs.Range("K65536").End(xlUp))
    'Set rngArticle = myWs.Range(myWs.Range(Cells(4, i)), myWs.Range(Cells(65536, i)).End(xlUp))  
'ICI JE VOUDRAIT REMPLACER LA LIGNE D'AU DESSUS PAR CELLE SI, OU DU MOIN UN TRUC QUI VOUDRAIT DIRE LA MEME CHOSE ET QUI FONCTIONNE ^^
 
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    Dim xlWk As Workbook
    Set xlWk = xlApp.Workbooks.Open("C:\Users\fichier_source.xls")
    Dim xlWs As Worksheet
    Set xlWs = xlWk.Worksheets(1)
 
     Dim rngArticleRecherche As Range
    Set rngArticleRecherche = xlWs.Range(xlWs.Range("B2"), xlWs.Range("B65536").End(xlUp))
 
    Dim rngRefTrouve As Range
    Dim cell As Range
 
    For Each cell In rngArticle
        Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
        If rngRefTrouve Is Nothing Then
                  Else
            cell.Offset(, 1).Value = rngRefTrouve.Offset(, 6).Value
        End If
'Next SANS OUBLIER LE NEXT DE LA BOUCLE
Next
       Set xlWs = Nothing
    xlWk.Close (False)
    Set xlWk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

**Oliv-** · 20/11/2013, 14h55

Salut,
tu veux donc faire un action toute les 5 colonnes ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub test()
 
    MsgBox "ATTENTION, cela peu prendre un peu de temps, veuillez attendre sagement"
 
 
    'ICI L'INITIALISATION DE LA BOUCLE
    'Dim rngArticle As Range
    Dim myWs As Worksheet
    Set myWs = ThisWorkbook.Sheets("feuille_de_prix")
    For i = 11 To 81 Step 5
        'Set rngArticle = myWs.Range(myWs.Range("K4"), myWs.Range("K65536").End(xlUp))
        Set rngArticle = myWs.Range(myWs.Cells(4, i), myWs.Cells(65536, i).End(xlUp))
 
        rngArticle.Select
        'ICI JE VOUDRAIT REMPLACER LA LIGNE D'AU DESSUS PAR CELLE SI, OU DU MOIN UN TRUC QUI VOUDRAIT DIRE LA MEME CHOSE ET QUI FONCTIONNE ^^
 
        Dim xlApp As Object
        Set xlApp = CreateObject("Excel.Application")
        Dim xlWk As Workbook
        Set xlWk = xlApp.Workbooks.Open("C:\Users\fichier_source.xls")
        Dim xlWs As Worksheet
        Set xlWs = xlWk.Worksheets(1)
 
        Dim rngArticleRecherche As Range
        Set rngArticleRecherche = xlWs.Range(xlWs.Range("B2"), xlWs.Range("B65536").End(xlUp))
 
        Dim rngRefTrouve As Range
        Dim cell As Range
 
        For Each cell In rngArticle
            Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
            If rngRefTrouve Is Nothing Then
            Else
                cell.Offset(, 1).Value = rngRefTrouve.Offset(, 6).Value
            End If
        Next
 
    Next i
 
    Set xlWs = Nothing
    xlWk.Close (False)
    Set xlWk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

**Libesa** · 20/11/2013, 15h12

Peut être comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
DerLig=myWs.Cells(rows.count,i).End(xlUp).Row
set rngArticle=myWs.range(myWs.Cells(4,i),myWs.cells(DerLig,i))

Tu as sans doute aussi interet à remplacer ton find par l'utilisation de Dictionnary vu que tes plages de recherche ont l'air assez énorme.

**sharox** · 20/11/2013, 16h33

Oui c'est ca toute les 5 colonnes je veux que ca le fasse, de la 11 a la 81 (14colonnes au total)

la plage dans la quel je recherche fait 51266 lignes par la, mais cette liste peut évoluer a chaque moment .

et lz programme que tu as mis ne fonctionne pas chez moi...

**Oliv-** · 20/11/2013, 17h04

Envoyé par sharox

Oui c'est ca toute les 5 colonnes je veux que ca le fasse, de la 11 a la 81 (14colonnes au total)

la plage dans la quel je recherche fait 51266 lignes par la, mais cette liste peut évoluer a chaque moment .

et lz programme que tu as mis ne fonctionne pas chez moi...

c'est à dire ?

j'ai déplacé le bloc d'ouverture du second fichier excel, sinon ca l'ouvre à chaque boucle de i, mais sinon j'ai pas testé après "rngArticle.Select"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub test()
 
    MsgBox "ATTENTION, cela peu prendre un peu de temps, veuillez attendre sagement"
 
 
    'ICI L'INITIALISATION DE LA BOUCLE
    'Dim rngArticle As Range
    Dim myWs As Worksheet
    Set myWs = ThisWorkbook.Sheets("feuille_de_prix")
 
        Dim xlApp As Object
        Set xlApp = CreateObject("Excel.Application")
        Dim xlWk As Workbook
        Set xlWk = xlApp.Workbooks.Open("C:\Users\fichier_source.xls")
        Dim xlWs As Worksheet
        Set xlWs = xlWk.Worksheets(1)
 
        Dim rngArticleRecherche As Range
        Set rngArticleRecherche = xlWs.Range(xlWs.Range("B2"), xlWs.Range("B65536").End(xlUp))
 
        Dim rngRefTrouve As Range
        Dim cell As Range
    For i = 11 To 81 Step 5
        'Set rngArticle = myWs.Range(myWs.Range("K4"), myWs.Range("K65536").End(xlUp))
        Set rngArticle = myWs.Range(myWs.Cells(4, i), myWs.Cells(65536, i).End(xlUp))
 
        rngArticle.Select
        'ICI JE VOUDRAIT REMPLACER LA LIGNE D'AU DESSUS PAR CELLE SI, OU DU MOIN UN TRUC QUI VOUDRAIT DIRE LA MEME CHOSE ET QUI FONCTIONNE ^^
 
 
 
        For Each cell In rngArticle
            Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
            If rngRefTrouve Is Nothing Then
            Else
                cell.Offset(, 1).Value = rngRefTrouve.Offset(, 6).Value
            End If
        Next
 
    Next i
 
    Set xlWs = Nothing
    xlWk.Close (False)
    Set xlWk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

**sharox** · 21/11/2013, 08h58

Re bonjour

Excuse moi ce que vous m'avez donné marche très bien
Hier je voulais modifié ce que j'avais mis mais le site était en maintenance, et après j'ai oublié, donc je le fait ce matin

Excusé moi :'

Je vous Remercie grandement pour l'aide que vous m'avez fournis !

Cordialement a tous !

utilisation d'une boucle qui ne fonctionne pas [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager