Bonjour à tous !
Après avoir créé une macro utilisant plusieurs InputBox et une boucle conditionnelle utilisant les données entrées dans les InputBox, j'ai voulu simplifier la procédure en utilisant un unique UserForm contenant plusieurs TextBox correspondant au champs anciennement renseignés dans mes InputBox.
Seulement voila, ma boucle ne foncionne plus correctement et réagit désormais de façon un peu eratique.
Ma façon de procéder a été la suivante:
J'ai tout d'abord renommé mes textbox
J'ai déclaré mes variables
Puis copié/collé cette macro dans le code UserForm1
Enfin j'ai fais un "Call" vers cette procedure lorsque le Bouton Executer est cliquer.
Voici le code en question:
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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96 Private Sub Exécuter_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button Then Call TRIP Unload UserForm1 Sheets("Gestion").Activate End Sub Sub TRIP() Sheets("Gestion").Activate lDerniereLigne = Range("W1").End(xlDown).Address lDerniereLigne = Range(lDerniereLigne).Row For I = 2 To lDerniereLigne While Range("S" & I) <> Empty Rows(I).Select Selection.Delete Shift:=xlUp Wend Next Sheets("Projets négo").Activate Dim minkch As Integer Dim maxkch As Integer Dim montantexportmin As Long Dim montantexportmax As Long Dim montantimportmin As Long Dim montantimportmax As Long Dim echeance As Date Dim Devise2 As String Dim Devise1 As String lDerniereLigneReelle = Range("W2").End(xlDown).Address lDerniereLigneReelle = Range(lDerniereLigneReelle).Row Range("A:A,E:E").Replace What:=" ", Replacement:="", LookAt:=xlPart Range("A:A,E:E").Replace What:="à", Replacement:="", LookAt:=xlPart End Sub For u = 2 To lDerniereLigneReelle If Range("A" & u) = UserForm1.Devise1.Text And Range("B" & u) = UserForm1.Devise2.Text Then If Range("S" & u) >= UserForm1.minkch.Value _ And Range("S" & u) <= UserForm1.maxkch.Value _ And Range("K" & u) <= UserForm1.echeance _ And UserForm1.montantexportmin.Value >= Range("L" & u).Value _ And Range("L" & u) <= UserForm1.montantexportmax.Value Then Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow End If Else If UserForm1.Devise1.Text = "" _ And Range("B" & u) = UserForm1.Devise2.Text Then If Range("S" & u) >= UserForm1.minkch.Value _ And Range("S" & u) <= UserForm1.maxkch.Value _ And Range("K" & u) <= UserForm1.echeance _ And Range("L" & u) <= UserForm1.montantexportmax.Value _ And Range("L" & u) >= UserForm1.montantexportmin.Value Then Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow End If Else If Range("A" & u) = UserForm1.Devise1.Text _ And UserForm1.Devise2.Text = "" Then If Range("S" & u) >= UserForm1.minkch.Value _ And Range("S" & u) <= UserForm1.maxkch.Value _ And Range("K" & u) <= UserForm1.echeance _ And Range("L" & u) <= UserForm1.montantexportmax.Value _ And Range("L" & u) >= UserForm1.montantexportmin.Value Then Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow End If Else If UserForm1.Devise1.Text = "" _ And UserForm1.Devise2.Text = "" Then If Range("S" & u) >= UserForm1.minkch.Value _ And Range("S" & u) <= UserForm1.maxkch.Value _ And UserForm1.montantexportmin >= Range("L" & u) _ And Range("L" & u) <= UserForm1.montantexportmax Then Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow End If End If End If End If End If Next u Sheets("Gestion").Activate With ActiveSheet.UsedRange derLi = .Row + .Rows.Count - 1 End With Application.ScreenUpdating = False For R = derLi To 1 Step -1 If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete Next R Sheets("Gestion").Activate End Sub
Merci pour vos futurs éclairages.
Cordialement,
RSoul
Partager