Une proc=E9dure (modeste mais qui tourne)) =E0 adapter =E0 ton=20
probl=E8me.
je suis persuad=E9 qu'il est possible d'abr=E9ger, de=20
concentrer, d'am=E9liorer : si quelqu'un s'y attache, je=20
suis preneur.
Sub OuEtaitIl()
'Feuil4 un tableau de 3 colonnes
'La ligne 1 est r=E9serv=E9e aux titres des colonnes=20
(Date, Nom, Ville)
'La colonne A est au format : date
'Feuil5 un tableau idem qui sert =E0 effectuer la=20
recherche
'Cette proc=E9dure se trouve dans un module standard
'Il faudrait lui ajouter une gestion des erreurs
Dim i As Integer
Dim r As Integer
Dim C As Range
Dim Dt4 As Date
Dim Nm4 As String
Dim Vil4 As String
Worksheets("Feuil4").Activate
ActiveSheet.Range("A" & Range("A65536").End
(xlUp).Row).Select
r =3D ActiveCell.Row
Application.ScreenUpdating =3D False
For i =3D 2 To r
For Each C In Range(Cells(i, 1), Cells(i, 3)).Rows
'MsgBox C.Address (=E7a m'a servi pour v=E9rifier la=20
s=E9lection)
Dt4 =3D Cells(i, 1).Value
Nm4 =3D Cells(i, 2).Value
Vil4 =3D Cells(i, 3).Value
Worksheets("Feuil5").Activate
If ActiveSheet.Range("A" & Range("A65536").End
(xlUp).Row).Value =3D Dt4 Then
If ActiveSheet.Range("B" & Range("B65536").End
(xlUp).Row).Value =3D Nm4 Then
If ActiveSheet.Range("C" & Range("C65536").End
(xlUp).Row).Value <> "" Then
ActiveSheet.Range("C" & Range("C65536").End
(xlUp).Row + 1).Value =3D Vil4
End If
End If
End If
Worksheets("Feuil4").Activate
ActiveSheet.Range("A" & Range("A65536").End
(xlUp).Row).Select
r =3D ActiveCell.Row
Next C
Next i
Private Sub Worksheet_SelectionChange(ByVal Target As=20
Range)
'Proc=E9dure =E9venement en Feuil5
If ActiveSheet.Range("A" & Range("A65536").End
(xlUp).Row).Value <> 0 Then
If ActiveSheet.Range("B" & Range("B65536").End
(xlUp).Row).Value <> 0 Then
If ActiveSheet.Range("B" & Range("B65536").End
(xlUp).Row).Offset(0, 1).Value =3D 0 Then
OuEtaitIl
End If
End If
End If
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
André
Désolé, il manque la fin de la procédure module standard. Je te recopie le tout :
MODULE STANDARD :
Sub OuEtaitIl() Dim i As Integer Dim r As Integer Dim C As Range Dim Dt4 As Date Dim Nm4 As String Dim Vil4 As String Worksheets("Feuil4").Activate ActiveSheet.Range("A" & Range("A65536").End (xlUp).Row).Select r = ActiveCell.Row Application.ScreenUpdating = False For i = 2 To r For Each C In Range(Cells(i, 1), Cells(i, 3)).Rows 'MsgBox C.Address Dt4 = Cells(i, 1).Value Nm4 = Cells(i, 2).Value Vil4 = Cells(i, 3).Value Worksheets("Feuil5").Activate If ActiveSheet.Range("A" & Range("A65536").End (xlUp).Row).Value = Dt4 Then If ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Value = Nm4 Then If ActiveSheet.Range("C" & Range("C65536").End (xlUp).Row).Value <> 0 Then ActiveSheet.Range("C" & Range("C65536").End (xlUp).Row + 1).Value = Vil4 End If End If End If Worksheets("Feuil4").Activate ActiveSheet.Range("A" & Range("A65536").End (xlUp).Row).Select r = ActiveCell.Row Next C Next i Worksheets("Feuil5").Activate If ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Offset(0, 1) = 0 Then ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Offset(0, 1) = "???" End If Application.ScreenUpdating = True ActiveSheet.Range("A" & Range("A65536").End(xlUp).Row + 1).Select End Sub
FEUIL5 :
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveSheet.Range("A" & Range("A65536").End (xlUp).Row).Value <> 0 Then If ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Value <> 0 Then If ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Offset(0, 1).Value = 0 Then OuEtaitIl End If End If End If End Sub
Désolé, il manque la fin de la procédure module standard.
Je te recopie le tout :
MODULE STANDARD :
Sub OuEtaitIl()
Dim i As Integer
Dim r As Integer
Dim C As Range
Dim Dt4 As Date
Dim Nm4 As String
Dim Vil4 As String
Worksheets("Feuil4").Activate
ActiveSheet.Range("A" & Range("A65536").End
(xlUp).Row).Select
r = ActiveCell.Row
Application.ScreenUpdating = False
For i = 2 To r
For Each C In Range(Cells(i, 1), Cells(i, 3)).Rows
'MsgBox C.Address
Dt4 = Cells(i, 1).Value
Nm4 = Cells(i, 2).Value
Vil4 = Cells(i, 3).Value
Worksheets("Feuil5").Activate
If ActiveSheet.Range("A" & Range("A65536").End
(xlUp).Row).Value = Dt4 Then
If ActiveSheet.Range("B" & Range("B65536").End
(xlUp).Row).Value = Nm4 Then
If ActiveSheet.Range("C" & Range("C65536").End
(xlUp).Row).Value <> 0 Then
ActiveSheet.Range("C" & Range("C65536").End
(xlUp).Row + 1).Value = Vil4
End If
End If
End If
Worksheets("Feuil4").Activate
ActiveSheet.Range("A" & Range("A65536").End
(xlUp).Row).Select
r = ActiveCell.Row
Next C
Next i
Worksheets("Feuil5").Activate
If ActiveSheet.Range("B" & Range("B65536").End
(xlUp).Row).Offset(0, 1) = 0 Then
ActiveSheet.Range("B" & Range("B65536").End
(xlUp).Row).Offset(0, 1) = "???"
End If
Application.ScreenUpdating = True
ActiveSheet.Range("A" & Range("A65536").End(xlUp).Row +
1).Select
End Sub
FEUIL5 :
Private Sub Worksheet_SelectionChange(ByVal Target As
Range)
If ActiveSheet.Range("A" & Range("A65536").End
(xlUp).Row).Value <> 0 Then
If ActiveSheet.Range("B" & Range("B65536").End
(xlUp).Row).Value <> 0 Then
If ActiveSheet.Range("B" & Range("B65536").End
(xlUp).Row).Offset(0, 1).Value = 0 Then
OuEtaitIl
End If
End If
End If
End Sub
Désolé, il manque la fin de la procédure module standard. Je te recopie le tout :
MODULE STANDARD :
Sub OuEtaitIl() Dim i As Integer Dim r As Integer Dim C As Range Dim Dt4 As Date Dim Nm4 As String Dim Vil4 As String Worksheets("Feuil4").Activate ActiveSheet.Range("A" & Range("A65536").End (xlUp).Row).Select r = ActiveCell.Row Application.ScreenUpdating = False For i = 2 To r For Each C In Range(Cells(i, 1), Cells(i, 3)).Rows 'MsgBox C.Address Dt4 = Cells(i, 1).Value Nm4 = Cells(i, 2).Value Vil4 = Cells(i, 3).Value Worksheets("Feuil5").Activate If ActiveSheet.Range("A" & Range("A65536").End (xlUp).Row).Value = Dt4 Then If ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Value = Nm4 Then If ActiveSheet.Range("C" & Range("C65536").End (xlUp).Row).Value <> 0 Then ActiveSheet.Range("C" & Range("C65536").End (xlUp).Row + 1).Value = Vil4 End If End If End If Worksheets("Feuil4").Activate ActiveSheet.Range("A" & Range("A65536").End (xlUp).Row).Select r = ActiveCell.Row Next C Next i Worksheets("Feuil5").Activate If ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Offset(0, 1) = 0 Then ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Offset(0, 1) = "???" End If Application.ScreenUpdating = True ActiveSheet.Range("A" & Range("A65536").End(xlUp).Row + 1).Select End Sub
FEUIL5 :
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveSheet.Range("A" & Range("A65536").End (xlUp).Row).Value <> 0 Then If ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Value <> 0 Then If ActiveSheet.Range("B" & Range("B65536").End (xlUp).Row).Offset(0, 1).Value = 0 Then OuEtaitIl End If End If End If End Sub
