(08/11/2020, 18:07)enginbeyy yazdı: Hocalarım şimdi eklediğim dosya sanki daha anlaşılır oldu.
Her kod numarasının merkez bilgisini, en küçük açık ve en küçük kapalı zaman bilgisini yanına çekmek istiyorum.
Bir de zaman formatında hata yapmamak için formatı değiştirmeden olduğu gibi yapsak da olur.

Bu dosyaya göre formül ile çözülebilir sanki.

(08/11/2020, 18:40)feraz yazdı:

(08/11/2020, 18:07)enginbeyy yazdı: Hocalarım şimdi eklediğim dosya sanki daha anlaşılır oldu.
Her kod numarasının merkez bilgisini, en küçük açık ve en küçük kapalı zaman bilgisini yanına çekmek istiyorum.
Bir de zaman formatında hata yapmamak için formatı değiştirmeden olduğu gibi yapsak da olur.

Bu dosyaya göre formül ile çözülebilir sanki.

Hadi inşallah

Eki inceler misiniz?

---

Kodlar
ana Fonksiyon

Function TekDeger()



SonStr = Range("A" & Rows.Count).End(3)(2, 1).Row

Set Bolge = Range("A2:A" & SonStr)



Dim tmp As String

Dim Benzersiz() As Variant



sinir = 0

tmp = ""

  For Each cell In Bolge

      If (cell <> "") And (InStr("|" & tmp & "|", "|" & cell & "|") = 0) Then

        tmp = tmp & cell & "|"

        ReDim Preserve Benzersiz(1, sinir)

      Benzersiz(0, sinir) = cell

      Benzersiz(1, sinir) = Range("B" & cell.Row)

      sinir = sinir + 1

      End If

  Next cell

  Benzersiz = Application.Transpose(Benzersiz)

Dim SonDizi() As Variant

ReDim SonDizi(UBound(Benzersiz), 3)





Indx = 0

For x = LBound(Benzersiz) To UBound(Benzersiz)



TmpMin = MinBul(Benzersiz(x, 1))



SonDizi(Indx, 0) = Benzersiz(x, 0 + 1)

SonDizi(Indx, 1) = Benzersiz(x, 1 + 1)

SonDizi(Indx, 2) = Split(TmpMin, ";")(0)

SonDizi(Indx, 3) = Split(TmpMin, ";")(1)

Indx = Indx + 1

Next x



SonStr = Range("g" & Rows.Count).End(3)(2, 1).Row

    Range("H2:K" & SonStr).ClearContents

    Range("H2").Resize(UBound(SonDizi), 4).Value = SonDizi

MsgBox "işlem bitti"

End Function

Minumum değeri bulma fornksiyonu

Function MinBul(ByVal KodDgr As String) As String



Dim Bolge As Range



Dim MinAcik As Double

Dim MinKapali As Double



MinAcik = 0

MinKapali = 0

x = 0

SonStr = Range("A" & Rows.Count).End(3)(2, 1).Row



Set Bolge = Range("A2:A" & SonStr)

For Each cell In Bolge

      

      If (cell = KodDgr) Then

        DblTrh = TrhCevir(Range("D" & cell.Row))

        

        If MinAcik = 0 Then

            MinAcik = DblTrh

        Else

            If Range("C" & cell.Row) = "AÇIK" And DblTrh < MinAcik Then MinAcik = DblTrh

        End If

        

        If MinKapali = 0 Then

            MinKapali = DblTrh

        Else

            If Range("C" & cell.Row) = "KAPALI" And DblTrh < MinKapali Then MinKapali = DblTrh

        End If

        

        x = x + 1

      End If

  Next cell

  

  MinBul = TrhDonsEski(CDate(MinAcik)) & " ; " & TrhDonsEski(CDate(MinKapali))

End Function

Tarihe dönüştürme fonksiyonu

Function TrhCevir(Trh As String) As Double



Dim TekKod() As String

Dim Trh2() As String

Dim Zmn() As String



Trh = Trim(Trh)

TekKod = Split(Trh)

Trh2 = Split(TekKod(0), "-")

Zmn = Split(TekKod(1), ".")

        If TekKod(UBound(TekKod)) = "PM" And Zmn(0) <> 12 Then Zmn(0) = Zmn(0) + 12



Select Case Trh2(1)

    Case "JAN"

        result = 1

    Case "FEB"

        result = 2

    Case "MAR"

        result = 3

    Case "APR"

        result = 4

    Case "MAY"

        result = 5

    Case "JUN"

        result = 6

    Case "JUL"

        result = 7

    Case "AUG"

        result = 8

    Case "SEP"

        result = 9

    Case "OCT"

        result = 10

    Case "NOV"

        result = 11

    Case "DEC"

        result = 12

End Select

Trh2(1) = result

ZmnDbl = CDate(Trh2(0) & "." & Trh2(1) & "." & "20" & Trh2(2)) + TimeValue(Zmn(0) & ":" & Zmn(1) & ":" & Zmn(2))



TrhCevir = CDbl(ZmnDbl)

End Function

İlk tarihe dönüştürme fonksiyonu

Function TrhDonsEski(Trh As Date) As String 

Ayhy = Choose(Month(Trh), "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC") 

TrhDonsEski = format(Trh,"dd") & "-" & Ayhy & "-" & Format(Trh, "yy") & " " & Format(Trh, "hh.mm.ss") 

End Function

H sütununa veriler özet tablo ile aldırdım.Diziler ile malisef benzersiz olarak getiremedim önceden getiren formüllerle.
Eğer Zaman sütunundaki veriler alt alta bu şekilde geliyorsa formülle yaptım deneyin abey.

Formülde hata olmuş.Dizi formülleridir.
J2

=İNDİS($D$1:$D$50;KAÇINCI(1;--(H2=$A$1:$A$50)*--(I2=$B$1:$B$50)*--($C$1:$C$50="AÇIK");0);1)

K2

=İNDİS($D$1:$D$50;KAÇINCI(1;--(H2=$A$1:$A$50)*--(I2=$B$1:$B$50)*--($C$1:$C$50="KAPALI");0);1)

(08/11/2020, 19:59)berduş yazdı: Eki inceler misiniz?

Hocam hali hazırda dosyada olan verileri doğru bir şekilde veriyor.
Fakat asıl verileri yapıştırınca kod numarasının açık ve kapalı verileri farklı olmasına rağmen fotoğraftaki gibi aynı verileri veriyor
[img][/img]