• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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.

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)))
 
Kod: 
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 formülleri yerlerine uyguladım hata veriyor, dosya ekte, bakabilir misiniz? çok teşekkür ederim
 

Ekli dosyalar

Hocam harika kod yazmışsınız. çok teşekkür ederim. ekte dosyada renkli gösterdiğim alanlarda boş veriyor bakabilir misiniz?
 
hocam pardon, dizi olarak girince sorun kalmadı. formüller tam olarak işimi gördü. çok teşekkür ederim.
 
ÖmerFaruk' Alıntı:
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)))
Genişletmek için tıkla ...
hocam pardon, dizi olarak girince sorun kalmadı. formüller tam olarak işimi gördü. çok teşekkür ederim.
 
veyselemre' Alıntı:
Kod: 
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
Genişletmek için tıkla ...
Hocam harika kod yazmışsınız. çok teşekkür ederim. ekte dosyada renkli gösterdiğim alanlarda boş veriyor bakabilir misiniz?
 
Alternatif formül;

DİZİ formüldür.

B3;
C++: 
=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;
C++: 
=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)
 
Korhan Ayhan' Alıntı:
Alternatif formül;

DİZİ formüldür.

B3;
C++: 
=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;
C++: 
=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)
Genişletmek için tıkla ...
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!!
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst