Tekrarlı değerlerin olduğu bir sütundan değer arayıp karşısındaki minumum ve maksimum tarihlerin satır sayılarını bulma.

[i.kazanci78]

Örnekteki dosyama yardımcı olabilirseniz çok sevinirim. Şimdiden çok teşekkür ederim hocam

 

[ÖmerFaruk]

Küçük için
=TOPLA.ÇARPIM((MİN(EĞER(A3=Sayfa2!$C$3:$C$1000;Sayfa2!$E$3:$E$1000;""))=Sayfa2!$E$3:$E$1000)*(A3=Sayfa2!$C$3:$C$1000)*(SATIR(Sayfa2!$C$3:$C$1000)))

Büyük için
=TOPLA.ÇARPIM((MAK(EĞER(A3=Sayfa2!$C$3:$C$1000;Sayfa2!$E$3:$E$1000;""))=Sayfa2!$E$3:$E$1000)*(A3=Sayfa2!$C$3:$C$1000)*(SATIR(Sayfa2!$C$3:$C$1000)))

 

[veyselemre]

Sub test()
    Dim data(), i&, yData(), dNo$, _
        t1 As Date, t2 As Date, say&, _
        t11 As Date, t22 As Date, sira&

    With Sheets("Sayfa2")
        data = .Range("C3:H" & .Cells(Rows.Count, "C").End(3).Row).Value
        ReDim yData(1 To UBound(data), 1 To 5)
    End With
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            dNo = data(i, 1)
            t1 = Format((data(i, 3) & " " & data(i, 4)), "dd.mm.yyyy hh:MM")
            If data(i, 5) <> "" Then
                t2 = Format((data(i, 5) & " " & data(i, 6)), "dd.mm.yyyy hh:MM")
            Else
                t2 = Empty
            End If
            If Not .exists(dNo) Then
                say = say + 1
                yData(say, 1) = dNo
                yData(say, 2) = i + 2
                yData(say, 3) = i + 2
                yData(say, 4) = t1
                If t2 <> Empty Then yData(say, 5) = t2
                .Item(dNo) = say
            Else
                sira = .Item(dNo)
                t11 = yData(sira, 4)
                t22 = yData(sira, 5)
                If CDate(t1) < CDate(t11) Then
                    yData(sira, 4) = t1: yData(sira, 2) = i + 2
                Else
                    If t2 <> Empty Then
                        If CDate(t2) > CDate(t22) Then yData(sira, 5) = t2: yData(sira, 3) = i + 2
                    Else
                        yData(sira, 5) = Empty: yData(sira, 3) = Empty
                    End If
                End If
            End If
        Next i
    End With
    With Sheets("Sayfa1")
        .Range("A3:C" & Rows.Count).ClearContents
        .Range("A3").Resize(say, 5).Value = yData
    End With

End Sub

 

[i.kazanci78]

hocam formülleri yerlerine uyguladım hata veriyor, dosya ekte, bakabilir misiniz? çok teşekkür ederim

 

[i.kazanci78]

Hocam harika kod yazmışsınız. çok teşekkür ederim. ekte dosyada renkli gösterdiğim alanlarda boş veriyor bakabilir misiniz?

 

[i.kazanci78]

hocam pardon, dizi olarak girince sorun kalmadı. formüller tam olarak işimi gördü. çok teşekkür ederim.

 

[i.kazanci78]

Küçük için
=TOPLA.ÇARPIM((MİN(EĞER(A3=Sayfa2!$C$3:$C$1000;Sayfa2!$E$3:$E$1000;""))=Sayfa2!$E$3:$E$1000)*(A3=Sayfa2!$C$3:$C$1000)*(SATIR(Sayfa2!$C$3:$C$1000)))

Büyük için
=TOPLA.ÇARPIM((MAK(EĞER(A3=Sayfa2!$C$3:$C$1000;Sayfa2!$E$3:$E$1000;""))=Sayfa2!$E$3:$E$1000)*(A3=Sayfa2!$C$3:$C$1000)*(SATIR(Sayfa2!$C$3:$C$1000)))

hocam pardon, dizi olarak girince sorun kalmadı. formüller tam olarak işimi gördü. çok teşekkür ederim.

 

[i.kazanci78]

Sub test()
    Dim data(), i&, yData(), dNo$, _
        t1 As Date, t2 As Date, say&, _
        t11 As Date, t22 As Date, sira&

    With Sheets("Sayfa2")
        data = .Range("C3:H" & .Cells(Rows.Count, "C").End(3).Row).Value
        ReDim yData(1 To UBound(data), 1 To 5)
    End With
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            dNo = data(i, 1)
            t1 = Format((data(i, 3) & " " & data(i, 4)), "dd.mm.yyyy hh:MM")
            If data(i, 5) <> "" Then
                t2 = Format((data(i, 5) & " " & data(i, 6)), "dd.mm.yyyy hh:MM")
            Else
                t2 = Empty
            End If
            If Not .exists(dNo) Then
                say = say + 1
                yData(say, 1) = dNo
                yData(say, 2) = i + 2
                yData(say, 3) = i + 2
                yData(say, 4) = t1
                If t2 <> Empty Then yData(say, 5) = t2
                .Item(dNo) = say
            Else
                sira = .Item(dNo)
                t11 = yData(sira, 4)
                t22 = yData(sira, 5)
                If CDate(t1) < CDate(t11) Then
                    yData(sira, 4) = t1: yData(sira, 2) = i + 2
                Else
                    If t2 <> Empty Then
                        If CDate(t2) > CDate(t22) Then yData(sira, 5) = t2: yData(sira, 3) = i + 2
                    Else
                        yData(sira, 5) = Empty: yData(sira, 3) = Empty
                    End If
                End If
            End If
        Next i
    End With
    With Sheets("Sayfa1")
        .Range("A3:C" & Rows.Count).ClearContents
        .Range("A3").Resize(say, 5).Value = yData
    End With

End Sub

Hocam harika kod yazmışsınız. çok teşekkür ederim. ekte dosyada renkli gösterdiğim alanlarda boş veriyor bakabilir misiniz?

 

[Korhan Ayhan]

Alternatif formül;

DİZİ formüldür.

B3;

=KAÇINCI($A3&MİN(EĞER(Sayfa2!$C$3:$C$1000=$A3;Sayfa2!$E$3:$E$1000+Sayfa2!$F$3:$F$1000));Sayfa2!$C$1:$C$1000&Sayfa2!$E$1:$E$1000+Sayfa2!$F$1:$F$1000;0)

C3;

=KAÇINCI($A3&MAK(EĞER(Sayfa2!$C$3:$C$1000=$A3;Sayfa2!$E$3:$E$1000+Sayfa2!$F$3:$F$1000));Sayfa2!$C$1:$C$1000&Sayfa2!$E$1:$E$1000+Sayfa2!$F$1:$F$1000;0)

 

[veyselemre]

Hocam harika kod yazmışsınız. çok teşekkür ederim. ekte dosyada renkli gösterdiğim alanlarda boş veriyor bakabilir misiniz?

Ekte dosya yok.. Boş alanlar halen hastanede yatanlar...

 

[i.kazanci78]

Alternatif formül;

DİZİ formüldür.

B3;

=KAÇINCI($A3&MİN(EĞER(Sayfa2!$C$3:$C$1000=$A3;Sayfa2!$E$3:$E$1000+Sayfa2!$F$3:$F$1000));Sayfa2!$C$1:$C$1000&Sayfa2!$E$1:$E$1000+Sayfa2!$F$1:$F$1000;0)

C3;

=KAÇINCI($A3&MAK(EĞER(Sayfa2!$C$3:$C$1000=$A3;Sayfa2!$E$3:$E$1000+Sayfa2!$F$3:$F$1000));Sayfa2!$C$1:$C$1000&Sayfa2!$E$1:$E$1000+Sayfa2!$F$1:$F$1000;0)

saat kısmını da değerlendirmeye alan formülünüz için çok teşekkür ederim hocam. Nasıl sevindim anlatamam. Harika!!