maalesef istediğiniz gibi sayfaya yazılacak bir kod ile olmadı
eklenen butona basınca işlem gerçekleşir
Not: tarih alma formatınızdaki en büyük sorun gerçek tarih değeri içermemesi
mesela yıllar 2 haneli ozaman girilen tarih 2020 mi yosa 1920 mi anlaşılmıyor
ben 2000li yıllar varsayıp öyle hesaplattım ama dikkatli olunmalı
eğer gerçek verilerinizde 2000 öncesi veri varsa sorun çıkar
aşağıdaki kodlar yeni bir modül eklenip ona yapıştırılacak
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("A3:A" & SonStr)
For Each cell In Bolge
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
MinBul = TrhDonsEski(CDate(MinAcik)) & " ; " & TrhDonsEski(CDate(MinKapali))
End Function
Function TekDeger()
SonStr = Range("A" & Rows.Count).End(3)(2, 1).Row
Set Bolge = Range("A3:A" & SonStr)
Dim tmp As String
Dim Benzersiz() As Variant
sinir = 0
For Each cell In Bolge
If (cell <> "") And (InStr("|" & tmp & "|", "|" & cell & "|") = 0) And (InStr(Range("B" & cell.Row), "MERKEZİ") > 0) Then
tmp = tmp & cell & "|"
sinir = sinir + 1
End If
Next cell
ReDim Benzersiz(sinir - 1, 1)
sinir = 0
tmp = ""
For Each cell In Bolge
If (cell <> "") And (InStr("|" & tmp & "|", "|" & cell & "|") = 0) And (InStr(Range("B" & cell.Row), "MERKEZİ") > 0) Then
tmp = tmp & cell & "|"
Benzersiz(sinir, 0) = cell
Benzersiz(sinir, 1) = Range("B" & cell.Row)
sinir = sinir + 1
End If
Next cell
Dim SonDizi() As Variant
ReDim SonDizi(UBound(Benzersiz), 3)
Indx = 0
For x = LBound(Benzersiz) To UBound(Benzersiz)
TmpMin = MinBul(Benzersiz(x, 0))
SonDizi(Indx, 0) = Benzersiz(x, 0)
SonDizi(Indx, 1) = Benzersiz(x, 1)
SonDizi(Indx, 2) = Split(TmpMin, ";")(0)
SonDizi(Indx, 3) = Split(TmpMin, ";")(1)
Indx = Indx + 1
Next x
Range("g3:j" & SonStr).ClearContents
Range("g3").Resize(UBound(SonDizi), 4).Value = SonDizi
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 AM/PM")
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
