Optimisation de code / boucle

lioneldu47

XLDnaute Occasionnel
Bonjour le forum,

J'ai créé un code qui fonctionne pour ce que je veux faire mais il est très long. J'aimerais savoir comment faire pour le racourcir avec une boucle par exemple. Voici le code :

Private Sub CheckBox1_Click()
Dim myVar1 As Long
Dim myVar2 As Long
Dim myVar3 As Long
Dim myVar4 As Long
Dim myVar5 As Long
Dim myVar6 As Long

If Txtcode <> "" Then Txtcode = "" Else Txtcode = "Emergence " & 1
On Error Resume Next
myVar1 = Application.WorksheetFunction _
.Match(Txtcode, Worksheets("NPG").Range("A1:A65000"), 0)
On Error GoTo 0
If myVar1 <> 0 Then Txtcode = "Emergence " & 2 Else Exit Sub

On Error Resume Next
myVar2 = Application.WorksheetFunction _
.Match(Txtcode, Worksheets("NPG").Range("A1:A65000"), 0)
On Error GoTo 0
If myVar2 <> 0 Then Txtcode = "Emergence " & 3 Else Exit Sub

On Error Resume Next
myVar3 = Application.WorksheetFunction _
.Match(Txtcode, Worksheets("NPG").Range("A1:A65000"), 0)
On Error GoTo 0
If myVar3 <> 0 Then Txtcode = "Emergence " & 4 Else Exit Sub

On Error Resume Next
myVar4 = Application.WorksheetFunction _
.Match(Txtcode, Worksheets("NPG").Range("A1:A65000"), 0)
On Error GoTo 0
If myVar4 <> 0 Then Txtcode = "Emergence " & 5 Else Exit Sub

On Error Resume Next
myVar5 = Application.WorksheetFunction _
.Match(Txtcode, Worksheets("NPG").Range("A1:A65000"), 0)
On Error GoTo 0
If myVar5 <> 0 Then Txtcode = "Emergence " & 6 Else Exit Sub

On Error Resume Next
myVar6 = Application.WorksheetFunction _
.Match(Txtcode, Worksheets("NPG").Range("A1:A65000"), 0)
On Error GoTo 0
If myVar6 <> 0 Then Txtcode = "Emergence " & 6 Else Exit Sub
End Sub



J'aimerais aller jusqu'à Txtcode = "Emergence " & 100 alors que pour le moment je ne suis qu'à Txtcode = "Emergence " & 6. Imaginez la longueur du code final.

Merci de m'aider à diminuer et à optimiser ce code. Merci pour votre aide.

Bonne journée.
 

francedemo

XLDnaute Occasionnel
Re : Optimisation de code / boucle

bonjour,
à essayer :

Code:
Dim i as Integer

For i = 1 to 100

If Txtcode <> "" Then Txtcode = "" Else Txtcode = "Emergence " & i
On Error Resume Next
    myVar & i = Application.WorksheetFunction _
        .Match(Txtcode, Worksheets("NPG").Range("A1:A65000"), 0)
    On Error GoTo 0
       If myVar & i <> 0 Then Txtcode = "Emergence " & i + 1 Else Exit Sub

Next i

sans fichier, pas pu tester ...

à +
 

lioneldu47

XLDnaute Occasionnel
Re : Optimisation de code / boucle

Re bonjour,

Afin de mieux comprendre mon problème voici le fichier. Merci Francedemo mais je n'arrive pas à faire fonctionner ton code.

En cliquant sur macro1 l'userform1 s'ouvre. Sur celui-ci lorsque l'on clique sur la checklist "emergence", j'aimerais qu'il y ait une recherche sur les codes de la colonne A de la feuille NPG afin de mettre dans la listbox "txtcode" le premier emergence qui n'existe pas. Par exemple, il existe emergence 1, emergence 4, emergence 2, emergence 12...
emergence 3 est le premier qui n'existe pas donc je voudrais que emergence 3 apparaisse dans "txtcode".

J'espère qu ele fichier vous aidera à comprendre.

Merci pour votre aide.
 

Pièces jointes

  • emergence.xlsm
    18.7 KB · Affichages: 43

lioneldu47

XLDnaute Occasionnel
Re : Optimisation de code / boucle

Francedemo j'arrive à faire fonctionner ton code mais ça ne s'arrête pas à la première valeur qui n'existe pas soit emergence 3 dans le fichier? Ca m'affiche emergence 101, donc dès que le code trouve une valeur qui n'existe pas il continue quand même.

Merci quand même
 

ERIC S

XLDnaute Barbatruc
Re : Optimisation de code / boucle

re

peut-être

Code:
Private Sub CheckBox1_Click()
Dim myVar1 As Long
On Error GoTo inexistant
Txtcode = "Emergence "
For i = 1 To 100
myVar1 = Application.WorksheetFunction _
.Match(Txtcode & i, Worksheets("NPG").Range("A1:A65000"), 0)
Next
Exit Sub
inexistant:
Txtcode = Txtcode & i

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 844
Messages
2 092 760
Membres
105 529
dernier inscrit
StarExcel