İki Koşullu arayarak birden fazla değer bulmak

[HakanKontek]

Değerli grup yönetici ve üyeleri,

Hepinize hayırlı geceler,

Forma yeni üye oldum, o sebeple bir yanlışım olursa afadersiniz.
Ekte gönderdiğim tablo hakkında yardımlarınızı arz ederim.

Saygılarımla.

 

[Korhan Ayhan]

Selamlar,

Forumumuza hoşgeldiniz.

Ekte iki farklı çözüm hazırladığım örnek dosyayı incelermisiniz.

1. Çözüm;
ÖZET TABLO

2. Çözüm;
MAKRO

Uygulanan kod;

Option Explicit
 
Sub ÖZET_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, BUL As Range, ADRES As String
 
    Application.ScreenUpdating = False
 
    Set S1 = Sheets("Gunluk")
    Set S2 = Sheets("ÖZET")
 
    S2.Range("A:C").ClearContents
    S2.Range("C1") = "Fat No"
    S1.Range("C5:D65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S2.Range("A1"), Unique:=True
    S2.Range("A2:B65536").Sort Key1:=S2.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    For X = 2 To S2.Range("A65536").End(3).Row
        Set BUL = S1.Range("C5:C65536").Find(S2.Cells(X, 1), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If BUL.Offset(0, 1) = S2.Cells(X, 2) Then
                S2.Cells(X, 3) = IIf(S2.Cells(X, 3) = "", BUL.Offset(0, 2), S2.Cells(X, 3) & "," & BUL.Offset(0, 2))
            End If
        Set BUL = S1.Range("C5:C65536").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    Next
 
    S2.Select
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[muygun]

Merhaba;
Korhan Bey'in çözümlerine ilave olarak işlevlerle bir çözümde benden.
İyi çalışmalar.

 

[HakanKontek]

Merhabalar;

Hoşbulduk, Çok değerli vaktinizden ayırıp yardımlaşma adına harcadığınız emekten dolayı sizlere çok teşekkür ederim.
Sizlere yeterince doğru bilgiyi aktarmadığımdan, malesef göndermiş olduğunuz formüller benim durumuma çözüm olmadı.
Sn.Korhan Bey'in göndermiş olduğu makro otf kısmındaki stf hücrelerindeki bazı bilgileri sildiğimde ve tekrar butona bastığımda yine stf hücrelerindeki bilgiyi yerine koyuyor, halbuki stf kısmına bir işlem yapmaması gerek ayrıcada zaten bu göndermiş olduğum tabloya baktığınızda tam istediğim işlevin bu olmadığını göreceksiniz.
Sn.M.Uygun bey'in göndermiş olduğu formulde ise stf nosu sayı olarak algılamakta yani stf nosuna metin karakterleri girdiğimde formül çalışmamakta.
Bu nedenlerden ötürü ekte tam detaylı olarak yapmaya çalıştığım tablo görülmekte. Eğer mümkünse makro kullanmadan formül yoluyla bir çözüm üretilirse çok memnun olurum. Değerli yardımlarınızı arz eder, harcadığınız emekten dolayı tekrar teşekkürlerimi sunarım.

 

[Korhan Ayhan]

Selamlar,

Özellikle formülle istediğiniz için yardımcı sütunlar kullanarak bir çözüm hazırladım. Umarım istediğiniz gibi olmuştur.

 

[HakanKontek]

Sn.Korhan bey,

Yaptığınız tablo benim istediğim gibi oldu çok sağolun,
Yanlız; Tarihleri toparlarken ekte göreceğiniz üzere tarih biçiminde görüntü vermiyor ve on hücreye kadar bilgi topluyor. Birde affınıza sığınarak ilave bir sorun daha girdim tabloya. Aslında sayenizde birçok hatamı keşfettim. Çözemeyeceğim bana göre çok zor olanı tekrar size sormak durumunda kaldım,
çok hızlı cevaplarınız içinde ayrıca teşekkürederim.

 

[Korhan Ayhan]

Selamlar,

Dosyanızda kurguladığım formüller 10 adet veriye kadar listeleme yapıyor. Siz kaç adet veri listelemek istiyorsunuz. Eğer miktar fazla ise makro ile çözüme dönmek gerekebilir.

 

[HakanKontek]

Tam olarak belli bir miktar veremiyorum, yani 5 te olabilir 50'de o sebeple makro uygunsa makroda olabilir, formül istememin sebebi makroları kullanacak kadar bilgim olmaması, ancak en azından gerektiği kadar öğrenmeye çalışırım. Saygılarımla,

 

[HakanKontek]

Sn. Korhan Bey,

Bildiğiniz gibi problemim tam manasıyla çözülmediği için beklemedeyim, müsait zamanınız olduğunda yardımcı olacağınıza inanıyorum. Sanırım çözümlenemiyecek bir konu değil, fakat olmuyorsada en azından bilgilendirirseniz çok memnum olurum.Zira duruma göre tabloyu sonlandırıp kullanımına başlayacağım. İşlerinizde başarılar diler, saygılarımı sunarım.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Kodu 2007 ve üzeri versiyon için düzenledim. Eski versiyonda denemek isteyen arkadaşlarımız kod içindeki 1048576 değerini 65536 olarak değiştirip kullanabilirler.

Option Explicit
 
Sub BİLGİLERİ_DÜZENLE()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long
    Dim BUL As Range, ADRES As String, Son_Satır As Long, Formül As String
 
    Application.ScreenUpdating = False
 
    Set S1 = Sheets("OTF")
    Set S2 = Sheets("STOKGIRIS")
 
    S1.Range("AN3:AP1048576").ClearContents
    S2.Range("T7:T1048576").ClearContents
    Son_Satır = S2.Range("A1048576").End(3).Row
    For X = 3 To S1.Range("A1048576").End(3).Row
        If S1.Cells(X, "K") <> "" Then
            Set BUL = S2.Range("C:C").Find(S1.Cells(X, "K"), LookAt:=xlWhole)
            If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
                If BUL.Offset(0, 16) = S1.Cells(X, "B") Then
                    S1.Cells(X, "AN") = IIf(S1.Cells(X, "AN") = "", BUL.Offset(0, 19), S1.Cells(X, "AN") & " , " & BUL.Offset(0, 19))
                    S1.Cells(X, "AO") = IIf(S1.Cells(X, "AO") = "", Format(BUL.Offset(0, 21), "dd.mm.yyyy"), S1.Cells(X, "AO").Text & " , " & Format(BUL.Offset(0, 21), "dd.mm.yyyy"))
                    Formül = "=SUMPRODUCT((" & S2.Name & "!S7:S1048576&" & S2.Name & "!C7:C1048576=""" & Cells(X, "B") & "" & "" & Cells(X, "K") & """)*(" & S2.Name & "!AE7:AE1048576))"
                    S1.Cells(X, "AP") = Evaluate(Replace(Formül, 1048576, Son_Satır))
                End If
            Set BUL = S2.Range("C:C").FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
            End If
        End If
    Next
 
    For X = 7 To S2.Range("A1048576").End(3).Row
        If S2.Cells(X, "C") <> "" Then
            Set BUL = S1.Range("K:K").Find(S2.Cells(X, "C"), LookAt:=xlWhole)
            If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
                S2.Cells(X, "T") = IIf(S2.Cells(X, "T") = "", BUL.Offset(0, -9), S2.Cells(X, "T") & " , " & BUL.Offset(0, -9))
            Set BUL = S1.Range("K:K").FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
            End If
        End If
    Next
 
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[HakanKontek]

Sn.Korhan Bey,

Sorunum çözüldü, size çok teşekkür ederim. emeğinize, elinize sağlık.
STOKGIRIS sayfasında makro butonunu çalıştırdığımda OTF deki tutar kısmına "0" atıyordu.
Sonra butonu OTF sayfasında oluşturup makroyu çalıştırdım ve tutar kısmına tam olarak atmaya başaladı. Bu durumu anlayamadım ama farketmez işim görüldü. Tekrar teşekkür eder, Başarılarınızın devamını dilerim, Sağlıcakla kalın, Saygılarımla.