VBA/Excel Comparer 3 colonne, choisir une spécifique cellule

Bonjour,

J'ai besoin d'aide pour une travail

Je vous jont un exemple et merci

le but :

- Transférer revenu de la Feuil2 à Feuil1 , le soucis c'est qu'il faut comparer la Contract NO et ID et ne prendre que PU dans la colonne DT.

Si maintenant on a PAD dans la colonne 3 de la feuil2 il faut afficher pas encore fini

Si il y a pas de correspondance on affiche : Pas de correspondance

Si le revenu est 0 il faut afficher Erreur

Merci !!!!!!!

Bonjour,

Peut-être plus simple mais à tester

Bonjour Canteen,

je ne sais pas si j'ai bien compris mais voilà déjà un premier jet à coller en Feuille2.

La macro démarre quand tu cliques sur la première ligne en Feuille2.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Not Application.Intersect(Target, Range("A1:Z1")) Is Nothing Then
    '
    Application.ScreenUpdating = False
    '
    With Sheets(1)
        .Cells(1, 1) = "Contact NO"
        .Cells(1, 2) = "ID"
        .Cells(1, 3) = "Revenu"
        iRow = Range("A" & Rows.Count).End(xlUp).Row
        '
        For x = 2 To iRow
            Sheets(2).Range("A" & x & ":B" & x).Copy Destination:=.Range("A" & x & ":B" & x)
            Select Case Cells(x, 3)
                Case "PU"
                    .Cells(x, 3) = Sheets(2).Cells(x, 4)
                Case "PAD"
                    .Cells(x, 3) = "Pas encore fini"
                Case Is = 0
                    .Cells(x, 3) = "Erreur"
                Case Else
                    .Cells(x, 3) = "Pas de correspondance"
            End Select
        Next
    End With
    '
    Application.ScreenUpdating = True
End If
'
Sheets(1).Activate
'
End Sub

Bon dimanche!

A+

J'ai pas rempli la feuille 1 j'ai oublié désolé !!!

Je vous joint le nouveau

Merci

Salut Canteen,

si tu pouvais déjà répondre à nos deux propositions, ça nous avancerait, vois-tu !!??!!

A+

En fait j'avais pas rempli la première feuille donc c'est plus la même chose c'est tout , je l'ai rempli et je vous l'ai renvoyer à vous

Bonsoir,

Une solution sous forme de fonction personnalisée, adaptable éventuellement à d'autres utilisations.

Arguments de la fonction: la tableau de référence à 4 colonnes (qu'il serait par ailleurs judicieux de nommer), le contact n° et l'Id cherchés.

Function REVENU(TabRef As Range, no, id)
    Dim d As Object, i%, k%, noid$
    Application.Volatile
    Set d = CreateObject("Scripting.Dictionary")
    With TabRef
        For i = 1 To .Rows.Count
            d(.Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3)) = .Cells(i, 4)
        Next i
    End With
    noid = no & id
    If d.exists(noid & "PU") Then
        If d(noid & "PU") = 0 Then
            REVENU = "Erreur"
        Else
            REVENU = d(noid & "PU")
        End If
    ElseIf d.exists(noid & "PAD") Then
        REVENU = "Non fini"
    Else
        REVENU = "Pas de correspondance"
    End If
End Function

Cordialement.

C'est effectivement ce que je recherche , Merciiiiii beaucoup !!!!!!!!! je vous souhaite une trés belle semaine

Bonsoir à tous,

Une autre façon de procéder :

Option Explicit
Sub test()
Dim a, i As Long, w, txt As String
    a = Sheets("Feuil2").Range("a1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If a(i, 3) = "PU" Or a(i, 3) = "PAD" Or a(i, 3) = "" Then
                txt = Join$(Array(a(i, 1), a(i, 2)), Chr(2))
                Select Case a(i, 3)
                    Case "PU"
                        If a(i, 4) = 0 Then
                            .Item(txt) = "Erreur"
                        Else
                            .Item(txt) = a(i, 4)
                        End If
                    Case "PAD"
                        .Item(txt) = "Pas encore fini"
                    Case ""
                        .Item(txt) = "Pas de correspondance"
                End Select
            End If
        Next
        a = Sheets("Feuil1").Range("a1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            txt = Join$(Array(a(i, 1), a(i, 2)), Chr(2))
            If .exists(txt) Then
                w = .Item(txt)
                a(i, 3) = w
            End If
        Next
        Sheets("Feuil1").Range("a1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
    End With
End Sub

klin89