RE: Formülle En Küçük Tarihleri Çekme - feraz - 08/11/2020
(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.
RE: Formülle En Küçük Tarihleri Çekme - enginbeyy - 08/11/2020
(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
RE: Formülle En Küçük Tarihleri Çekme - berduş - 08/11/2020
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 fonksiyonuFunction 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
RE: Formülle En Küçük Tarihleri Çekme - feraz - 08/11/2020
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.
RE: Formülle En Küçük Tarihleri Çekme - feraz - 08/11/2020
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)
RE: Formülle En Küçük Tarihleri Çekme - enginbeyy - 08/11/2020
(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]
|