Besoin d'aide pour faire une boucle loop sur une macro

Version imprimable

Bonjour les développeziens et les developpeziennes.

Je voudrai faire une boucle sur cette macro
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub renomer_tlssyp() ' renomer_tlssyp Macro Windows("Classeur1").Activate Sheets("Montants facturés par carte").Select Columns("E:E").Select selection.Find(What:="TLSSYP", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Offset(rowOffset:=0, columnOffset:=-4).Activate ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[4],Codex!C:C[2],2,FALSE)" selection.Copy ActiveCell.Offset(rowOffset:=0, columnOffset:=4).Activate selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveCell.Offset(rowOffset:=0, columnOffset:=-4).Activate Application.CutCopyMode = False selection.ClearContents End Sub
Et je ne sais pas comment faire.

J'explique un peu plus ce que je cherche a faire de cette boucle.

Je voudrai que tant que la macro trouve TLSSYP dans la colonne elle boucle et s'arrête des qu'elle ne trouve plus de TLSSYP.

j'aurai besoin de vos lumières pour cette solution ^^ je vous remercie par avance de votre aide que vous allez m'apporter

13/04/2010, 16h48
Fvandermeulen

Salut,

Fais une recherche sur la méthode .find (findnext en l'occurence)

A+
13/04/2010, 17h05
spacesheep

Merci de ton aide Fvandermeulen,

Peux tu m'expliquer un peu plus je débute dans ce monde et je ne te cache pas que je n'y comprend pas grand chose.

Re,
Vois le code ci-dessous, largement inspiré de l'explication de l'aide en VBA (touche F1).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub FindMethod()
Dim MaRech As Range, FirstAdd As String
    With ActiveSheet.Range("A1:A10") 'défini la plage de recherche
        Set MaRech = .Find("TLSSYP", LookIn:=xlValues)
        If Not MaRech Is Nothing Then
            FirstAdd = MaRech.Address
            Do
                'Faire ce que tu veux ici, pour l'exemple écrit trouvé dans la colonne B
                Cells(MaRech.Row, MaRech.Column + 1) = "Trouvé"
                Set MaRech = .FindNext(MaRech)
            Loop While Not MaRech Is Nothing And MaRech.Address <> FirstAdd
        End If
    End With
End Sub

A+

Merci de ton aide précieuse Fvandermeulen d^_^b

Ça Fonctionne bien.

Mais des que je lui demande de copier le résultat trouver pour le remplacer ca ne fonctionne plus.

Voici le code peut être que ca te parleras plus.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub renomer_tlssyp()
'
' renomer_tlssyp Macro
 
 
Dim MaRech As Range, FirstAdd As String
    With ActiveSheet.Range("E:E") 'défini la plage de recherche
        Set MaRech = .Find("TLSSYP", LookIn:=xlValues)
        If Not MaRech Is Nothing Then
            FirstAdd = MaRech.Address
            Do
                'Faire ce que tu veux ici, pour l'exemple écrit trouvé dans la colonne B
                Cells(MaRech.Row, MaRech.Column - 4) = "=VLOOKUP(RC[4],Codex!C:C[2],2,FALSE)"
                selection.Copy
    ActiveCell.Offset(rowOffset:=0, columnOffset:=4).Activate
    selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(rowOffset:=0, columnOffset:=-4).Activate
    Application.CutCopyMode = False
    selection.ClearContents
                Set MaRech = .FindNext(MaRech)
            Loop While Not MaRech Is Nothing And MaRech.Address <> FirstAdd
        End If
    End With

Encore merci Fvandermeulen de tes lumières, tu m'as fortement aidé :ccool:

Voici mon code final après plusieurs teste

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub autre_test()
 
Sheets("Montants facturés par carte").Select
With Worksheets("Montants facturés par carte").Range("e:e")
    Set c = .Find("TLSSYP", LookIn:=xlValues)
 
    If Not c Is Nothing Then
 
        Do
            Cells(c.Row, c.Column - 4) = "=VLOOKUP(RC[4],Codex!C:C[2],2,FALSE)"
            c.Value = Cells(c.Row, c.Column - 4)
            Set c = .FindNext(c)
        Loop While Not c Is Nothing
    End If
 
    Columns("A:A").ClearContents
 
End With
 
End Sub

C'est bien plus court et plus joli que mon 1er code