3 lü eşleştirme

[EmrExcel16]

Merhaba , tablodaki D sütunundaki durum kısmına (boyalı kısım) ihtiyacım var ama yapamadım. yapmak istediğim şey 1.tablodaki yazdıklarımın 2.tablodaki eşleşmelerle tutması ve ok vermesi tutmuyor ise nok vermesi (eşleştirmeler yatay olarak kontrol ediliyor) mümkün ise kod ile çözümü değil ise formül ,yapamamamın sebebi 1.tablodaki sıralamanın karışık olması .yardımlarınız için şimdiden teşekkür ederim kolay gelsin.

 

[çıtır]

D2 Kopyalayınız.Aşağı doğru çoğaltınız.

=EĞER(YADA(EĞERSAY($F$2:$H$2;A2)+EĞERSAY($F$2:$H$2;B2)+EĞERSAY($F$2:$H$2;C2)=3;EĞERSAY($F$3:$H$3;A2)+EĞERSAY($F$3:$H$3;B2)+EĞERSAY($F$3:$H$3;C2)=3);"ok";"nok")

 

[EmrExcel16]

Sayın @çıtır öncelikle cevabınız için teşekkür ederim ,vermiş olduğum tablodaki verileri örnek olması acısından az tuttum veriler çoğaldığında vermiş olduğunuz formül çok uzayacak gibi ki zaten formul tam olarak doğruyu vermiyor , istemiş olduğum şey tablo 1 deki yatay verilerin (sıralaması farketmeksizin) tablo 2 deki verilerle birebir eşleşmesi. şöyle ki 1 tabloda Elma ,Armut , kiraz (sıralama değişebilir) varsa 2. tabloda bu verilerle eşleşen bir satır varsa ok verecek. Tekrardan cevabınız için teşekkür ederim

 

[çıtır]

Sayın @EmrExcel16;
Formül uzun ve vba ile çözüm daha iyi olur haklısınız.Formülün mevcut halini kontrol ettim doğru sonuc veriyor.Dönüş yaptığınız için teşekkür ederim.

 

[EmrExcel16]

Anlayışınız için ben teşekkür ederim, Yanlış sonuç olarak şöyle anlatayım mesela 6.satır 2. sutun (B6) Muz yazıyor doğru sonucu veriyor ki doğru fakat aynı hücreye Armut yazarsam da doru sonucu veriyor hatalı vermesi lazım çünkü 2. tabloda Vişne , Armut ,Armut ile eşleşen satır yok.

 

[EmrExcel16]

Merhaba arkadaşlar kendi sorumu cevaplamak istiyorum aşağıdaki kodlar ile bu eşleştirme yapılabilir , belki bu tür bir eşleştirmeye birilerinin ihtiyacı olur .

Sub Uclu_Esletir()
Dim i As Integer, x As Integer, y As Integer, z As Integer
i = 2
basadon:
Do While Cells(i, 1) <> ""
    For x = 2 To Cells(Rows.Count, 6).End(xlUp).Row
        For y = 6 To 8
            If Cells(i, 1) = Cells(x, y) Then
                For z = 6 To 8
                    If Application.CountIf(Range("A" & i & ":C" & i), Cells(x, z)) <> 1 Then
                        Cells(i, 4).Value = "nok"
                        Exit For
                    Else
                        Cells(i, 4).Value = "ok"
                    End If
                Next
                If Cells(i, 4).Value = "ok" Then
                    i = i + 1
                    GoTo basadon
                End If
            End If
        Next
    Next
    If Cells(i, 4).Value = "" Then Cells(i, 4).Value = "nok"
    i = i + 1
Loop
End Sub