Değerli hocalarım hepinize ayrı ayrı teşekkür ederim.
Paylaştığınız dosyaların hepsi de çok faydalı oldu.
istediğim sonucu aldım. Sağlıcakla kalın.
Formülle En Küçük Tarihleri Çekme
aşağıdaki kod da aşağı çek tarzında dilerim işinize yarar
G3, H3, I3 ve J3 seçip aşağıya doğru çekip dener misiniz?
G3 satırının kodu
Bir gif de ben ekleyeyim)
![[Resim: do.php?img=10588]](https://resim.accesstr.net/do.php?img=10588)
https://resim.accesstr.net/do.php?img=10588
G3, H3, I3 ve J3 seçip aşağıya doğru çekip dener misiniz?
G3 satırının kodu
{=EĞERHATA(İNDİS($A$3:$A$30; KAÇINCI(0;EĞER(EBOŞSA($A$3:$A$30);1;EĞERSAY($G$2:G2; $A$3:$A$30)); 0));"")}Function MinBul(ByVal KodDgr As String, Indx As Byte) As String
On Error GoTo 10
Dim Bolge As Range
Dim MinAcik As Double
Dim MinKapali As Double
Dim Trh(2) As String
MinAcik = 0
MinKapali = 0
x = 0
SonStr = Range("A" & Rows.Count).End(3)(2, 1).Row
Set Bolge = Range("A3:A" & SonStr)
For Each cell In Bolge
If (cell = KodDgr) And (InStr(Range("B" & cell.Row), "MERKEZİ") > 0) Then Trh(0) = Range("B" & cell.Row)
If (cell = KodDgr) And (InStr(Range("B" & cell.Row), "MERKEZİ") = 0) Then 'And (InStr(tmp, cell) = 0) Then
DblTrh = TrhCevir(Range("B" & cell.Row))
If MinAcik = 0 Then
MinAcik = DblTrh
Else
If Range("C" & cell.Row) <> "" And DblTrh < MinAcik Then MinAcik = DblTrh
End If
If MinKapali = 0 Then
MinKapali = DblTrh
Else
If Range("D" & cell.Row) <> "" And DblTrh < MinKapali Then MinKapali = DblTrh
End If
x = x + 1
End If
Next cell
Trh(1) = CStr(TrhDonsEski(CDate(MinAcik)))
Trh(2) = CStr(TrhDonsEski(CDate(MinKapali)))
MinBul = Trh(Indx) 'Split(KodDgr, ";")
Exit Function
10
MinBul = ""
End Function
Function TrhDonsEski(Trh As Date) As String
Ayhy = Choose(Month(Trh), "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
TrhDonsEski = Day(Trh) & "-" & Ayhy & "-" & Format(Trh, "yy") & " " & Format(Trh, "hh.mm.nn")
End Function
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
Bir gif de ben ekleyeyim)
https://resim.accesstr.net/do.php?img=10588
PİVOTTAN SONRa_formul_hy.rar
(Dosya Boyutu: 18,29 KB | İndirme Sayısı: 7)
(07/11/2020, 23:28)berduş yazdı: aşağıdaki kod da aşağı çek tarzında dilerim işinize yararGifte saatte nokta var sayın hocammmm
G3, H3, I3 ve J3 seçip aşağıya doğru çekip dener misiniz?
G3 satırının kodu
Modül kodları{=EĞERHATA(İNDİS($A$3:$A$30; KAÇINCI(0;EĞER(EBOŞSA($A$3:$A$30);1;EĞERSAY($G$2:G2; $A$3:$A$30)); 0));"")}
Function MinBul(ByVal KodDgr As String, Indx As Byte) As String
On Error GoTo 10
Dim Bolge As Range
Dim MinAcik As Double
Dim MinKapali As Double
Dim Trh(2) As String
MinAcik = 0
MinKapali = 0
x = 0
SonStr = Range("A" & Rows.Count).End(3)(2, 1).Row
Set Bolge = Range("A3:A" & SonStr)
For Each cell In Bolge
If (cell = KodDgr) And (InStr(Range("B" & cell.Row), "MERKEZİ") > 0) Then Trh(0) = Range("B" & cell.Row)
If (cell = KodDgr) And (InStr(Range("B" & cell.Row), "MERKEZİ") = 0) Then 'And (InStr(tmp, cell) = 0) Then
DblTrh = TrhCevir(Range("B" & cell.Row))
If MinAcik = 0 Then
MinAcik = DblTrh
Else
If Range("C" & cell.Row) <> "" And DblTrh < MinAcik Then MinAcik = DblTrh
End If
If MinKapali = 0 Then
MinKapali = DblTrh
Else
If Range("D" & cell.Row) <> "" And DblTrh < MinKapali Then MinKapali = DblTrh
End If
x = x + 1
End If
Next cell
Trh(1) = CStr(TrhDonsEski(CDate(MinAcik)))
Trh(2) = CStr(TrhDonsEski(CDate(MinKapali)))
MinBul = Trh(Indx) 'Split(KodDgr, ";")
Exit Function
10
MinBul = ""
End Function
Function TrhDonsEski(Trh As Date) As String
Ayhy = Choose(Month(Trh), "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
TrhDonsEski = Day(Trh) & "-" & Ayhy & "-" & Format(Trh, "yy") & " " & Format(Trh, "hh.mm.nn")
End Function
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
Bir gif de ben ekleyeyim)
https://resim.accesstr.net/do.php?img=10588
Hepmi ben görürüm böyle şeyleri
Esas formatta da nokta vardi o nedenle ozellikle oyle formatladim
Yoksa TrhDonsEski fonksiyonunda nokta yerine : koymak sorun degil )
Yoksa TrhDonsEski fonksiyonunda nokta yerine : koymak sorun degil )
TrhDonsEski = Day(Trh) & "-" & Ayhy & "-" & Format(Trh, "yy") & " " & Format(Trh, "hh.mm.nn")
İ ve j sütundaki tatihlerdede 02 yerine 2 olarak görünüyor tarihtwki gün abey.
Ama her seyi de benden beklemeyin @feraz bey)
TrhDonsEski = Day(Trh) yerine TrhDonsEski = format(Trh, "dd") yazin olur biter
TrhDonsEski = Day(Trh) yerine TrhDonsEski = format(Trh, "dd") yazin olur biter
Konuyu Okuyanlar: 1 Ziyaretçi
