Discussion :

[irung]

Bonjour

Contexte:
Feuille(1) 2 colonnes (1 colonne string "O6:O177" et une colonne date "S6:S177").
Feuille(2) 1 colonne (string A5:A120) et 1 ligne (date "B4:EG4")

VBA
Je teste feuille(1).Colonne("O6:O177") feuille(2).colonne("A5:A120")
if cellule commune trouvée alors je teste
feuille(1).colonne("S6:S177") avec feuille(2).ligne("B4:EG4")
if cellule commune trouvée alors (là je bloque totalement) je me place sur l'intersection de la feuille(2) (colonne(A) et Ligne(B:EG)

Merci de vos retours

[ARTURO83]

Bonjour,

Essayez ceci

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
Sub recherche()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim v As Object, d As Object
    Application.ScreenUpdating = False
    Set f1 = Sheets("feuil1")
    Set f2 = Sheets("feuil2")
 
    For i = 6 To 177
        Val_f1 = f1.Cells(i, "O")
        Date_f1 = f1.Cells(i, "S")
 
        With f2.Range("A5:A120")
            Set v = .Find(Val_f1, LookIn:=xlValues, lookat:=xlWhole)
            If Not v Is Nothing Then
                Pos1 = v.Address
                Do
                    Set d = f2.Range("B4:EG4").Find(Date_f1, LookIn:=xlFormulas, lookat:=xlWhole)
                    If Not d Is Nothing Then
                        f2.Select
                        Cells(v.Row, d.Column).Select
                        Exit Sub
                    End If
                    Set v = .FindNext(v)
                Loop While v <> "" And v.Address <> Pos1
            End If
        End With
    Next i
    Set v = Nothing
    Set d = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

[irung]

Bonjour Arturo83,

Merci pour cette réponse rapide et efficace, cependant j'ai une

erreur d'exécution 91 Variable objet ou variable de bloc with non définie

L'erreur ce produit à cette ligne

Code :

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

Loop While v <> "" And v.Address <> Pos1

Merci

[ARTURO83]

Essayez avec celui_ci

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
Option Explicit
 
Sub recherche()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim v As Object, d As Object
    Dim i As Long
    Dim Val_f1 As String, Pos1 As String
    Dim Date_f1 As Date
 
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    For i = 6 To 177
       Val_f1 = f1.Cells(i, "O")
       Date_f1 = f1.Cells(i, "S")
 
       With f2.Range("A5:A120")
           Set v = .Find(Val_f1, LookIn:=xlValues, lookat:=xlWhole)
           If Not v Is Nothing Then
               Pos1 = v.Address
               Do
                   Set d = f2.Range("B4:EG4").Find(Date_f1, LookIn:=xlFormulas, lookat:=xlWhole)
                   If Not d Is Nothing Then
                       f2.Select
                       Cells(v.Row, d.Column).Select
                       Exit Sub
                   End If
                   Set v = .FindNext(v)
               Loop While v Is Nothing And v.Address <> Pos1
           End If
       End With
    Next i
    Set v = Nothing
    Set d = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

[irung]

Bonjour Arturo83

J'avais déjà intégré...

[ARTURO83]

et alors, ça marche ou pas?

[irung]

Non cela ne fonctionne pas tjrs la même erreur

[ARTURO83]

Bizarre, voici le fichier test, le problème est-il toujours là? sinon votre fichier est-il construit différemment?

Pièce jointe 550712

Cdlt

[irung]

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
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
'On Error GoTo Erreur
Dim i, d, v, Val_f1, Date_f1, Pos1
Dim f1 As Worksheet, f2 As Worksheet

Application.ScreenUpdating = False

'Déclaration des variables
Set f1 = Sheets("Plan d'Actions")
Set f2 = Sheets("Planning")

'Sélection de la cellule intersect
If Not Intersect(Target, Range("$R6:$R177")) Is Nothing Then
For i = 6 To 177
        Val_f1 = f1.Cells(i, "O")
        Date_f1 = f1.Cells(i, "S")
 
        With f2.Range("A5:A120")
            Set v = .Find(Val_f1, LookIn:=xlValues, lookat:=xlWhole)
                If Not v Is Nothing Then
                    Pos1 = v.Address
                    Do
                      Set d = f2.Range("B4:EG4").Find(Date_f1, LookIn:=xlFormulas, lookat:=xlWhole)
                        If Not d Is Nothing Then
                            f2.Select
                            Cells(v.Row, d.Column).Select
                            Selection = v.Offset(0, 3) & " " & Format(v.Offset(0, 6), "hh:mm")
                            Exit Sub
                        End If
                        Set v = .FindNext(v)
                    Loop While v <> "" And v.Address <> Pos1
            End If
        End With
    Next i
End If
        

'Erreur:
Application.ScreenUpdating = True
Set v = Nothing
Set d = Nothing
Set f1 = Nothing
Set f2 = Nothing
End Sub

Je vous ai mis en gras ce que j'ai rajouté

[ARTURO83]

Vous ne dites pas tout dès le début, je vous ai fourni un code qui fonctionne d'après ce que vous avez demandé. mais qui n'est pas tout à fait ce que vous voulez réellement.
Là je m'aperçois qu'en fait, il faut une macro évènementielle qui doit réagir à la saisie d'une valeur dans la colonne R,.
De plus, vous voulez copier dans la cellule trouvée dans "Planning", les valeurs concaténées des colonnes 3 et 6 de la feuille "Plan d'actions", dans ce cas il faut aussi relever les valeurs de la colonne 3 et 6 de la ligne sélectionnée. Est-ce bien cela?

Ca donnerait ceci:

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
Option Explicit
Dim i, d, v, Val_f1, Date_f1, Pos1
Dim f1 As Worksheet, f2 As Worksheet
Dim Val_Col3, Val_Col6
 
Sub Worksheet_Change(ByVal Target As Range)
 
    Application.ScreenUpdating = False
 
    'Déclaration des variables
    Set f1 = Sheets("Plan d'Actions")
    Set f2 = Sheets("Planning")
 
    'Sélection de la cellule intersect
    If Not Intersect(Target, Range("$R6:$R177")) Is Nothing Then
        Val_f1 = f1.Cells(Target.Row, "O")
        Date_f1 = f1.Cells(Target.Row, "S")
        Val_Col3 = f1.Cells(Target.Row, "C")
        Val_Col6 = f1.Cells(Target.Row, "F")
        Recherche
    End If
 
    Set v = Nothing
    Set d = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub
 
Sub Recherche()
    f2.Select
    With f2.Range("A5:A120")
        Set v = .Find(Val_f1, LookIn:=xlValues, lookat:=xlWhole)
        If Not v Is Nothing Then
            Pos1 = v.Address
            Do
                Set d = f2.Range("B4:EG4").Find(Date_f1, LookIn:=xlFormulas, lookat:=xlWhole)
                If Not d Is Nothing Then
                    f2.Cells(v.Row, d.Column) = Val_Col3 & " " & Format(Val_Col6, "hh:mm")
                    Exit Sub
                End If
                Set v = .FindNext(v)
            Loop While v <> "" And v.Address <> Pos1
        End If
    End With
End Sub

Cdlt

[irung]

Désolé je ne voulais pas trop solliciter le forum et essayer de me débrouiller
Oui vous avez bien compris mon objectif

[ARTURO83]

Pouvez-vous m'aider?

Oui bien sûr, mais le fichier en exemple que j'ai déposé fonctionne bien, peut-être que le votre à une structure différente, si c'est le cas il faut adapter.
Pouvez-vous déposer ici votre fichier sans les données confidentielles, juste ce qui est nécessaire pour faire les tests?

[irung]

Je vous ai mis mon fichier "edulcoré" en exemple. Merci

[ARTURO83]

Essayez ceci
Pièce jointe 550952

Cdlt

[irung]

Merci beaucoup. C'est ça super.
Par contre lorsque je rempli ma cellule O j'ai une erreur 91 qui apparait


Merci

[ARTURO83]

Bonjour,

Remplacez la ligne par celle-ci:

Code :

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

Loop While Not v Is Nothing And v.Address <> Pos1

Cdlt

[irung]

Bonjour Arturo83

Je viens d'essayer avec

Code :

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

Loop While Not v Is Nothing And v.Address <> Pos1

Et toujours même erreur 91

[ARTURO83]

Bonjour,

En fait l'erreur se produit si vous sélectionnez une valeur dans la colonne "R" alors que la colonne "S"(une date) est vide, ce qui génère une erreur. pour y remédier il faut aussi s'assurer qu'il y ait bien une date en "S".
donc la ligne incriminée et corrigée est:

Code :

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

    If Not Intersect(Target, Range("$R6:$R177")) Is Nothing And Cells(Target.Row, "S") <> "" Then

le fichier
Pièce jointe 551110

Cdlt

[irung]

Quand j’exécute pas a pas la macro et qu'il arrive ici

Code :

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

1
2
With f2.Range("A5:A120")
        Set v = .Find(Val_f1, LookIn:=xlValues, lookat:=xlWhole)

Tout va bien

Dès que j'arrive sur

Code :

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

Loop While Not v Is Nothing And v.Address <> Pos1

De nouveau la même erreur 91.

Autre question subsidiaire plus pour ma culture, pourquoi la ligne f2.b4:ge4 est elle touchée

[ARTURO83]

Pour que je puisse reproduire le problème, dites-moi sur quelle cellule agissez-vous?

Autre question subsidiaire plus pour ma culture, pkoi la ligne f2.b4:ge4 est elle touchée

pour 2 raisons:
-la première, c'est que vos dates sont issues de formules et excel ne me les trouvaient pas, j'ai donc dans un premier temps figer les valeurs des dates
-la deuxième, je transforme la date en numéro de série pour la recherche, ce qui évite d'avoir une inversion du mois avec le jour, exemple: 1/12/2020 et le 12/10/2020, en passant par le N° de série il n'y a plus de confusion possible.
-Enfin, à la fin de la recherche, tout est remis au bon format avec restitution des formules pour les calculs des dates.