Sub cevir()
son = Range("A" & Rows.Count).End(3).Row
For i = 3 To son
zaman = Range("B" & i).Value
If Right(zaman, 7) = "MERKEZİ" Then
Range("h" & i).Value = zaman
Else
Range("h" & i).Value = Application.Substitute(Application.Substitute(Application.Substitute(zaman, ".", ":"), ":", ".", 3), "000000", "")
Range("h" & i).NumberFormat = "dd.mm.yyyy hh:mm:ss.000"
End If
Next
End SubFunction 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
PİVOTTAN SONRA_hy.rar
(Dosya Boyutu: 24,68 KB | İndirme Sayısı: 8)
Sub cevir()
son = Range("A" & Rows.Count).End(3).Row
For i = 3 To son
zaman = Range("B" & i).Value
If Right(zaman, 7) = "MERKEZİ" Then
Range("B" & i).Value = zaman
Else
Range("B" & i).Value = Application.Substitute(Application.Substitute(Application.Substitute(zaman, ".", ":"), ":", ".", 3), "000000", "")
Range("B" & i).NumberFormat = "dd.mm.yyyy hh:mm:ss.000"
End If
Next
End Sub
Sub yaz()
Run "cevir"
son = Range("A" & Rows.Count).End(3).Row
For i = 3 To son
If Range("A" & i) <> Range("A" & i - 1) Then
ilk = Range("B" & i).Row
End If
If Range("A" & i) <> Range("A" & i + 1) Then
sonu = Range("B" & i).Row
yson = Range("G" & Rows.Count).End(3).Row + 1
ActiveSheet.Range("B" & ilk & ":D" & sonu).AutoFilter Field:=2, Criteria1:="1"
Range("I" & yson).Value = CDate(Application.Subtotal(105, Range("B" & ilk & ":B" & sonu)))
Selection.AutoFilter
ActiveSheet.Range("B" & ilk & ":D" & sonu).AutoFilter Field:=3, Criteria1:="1"
Range("J" & yson).Value = CDate(Application.Subtotal(105, Range("B" & ilk & ":B" & sonu)))
Selection.AutoFilter
Range("G" & yson).Value = Range("A" & ilk).Value
Range("H" & yson).Value = Range("B" & ilk).Value
End If
Next
End Sub
PİVOTTAN SONRA1.zip
(Dosya Boyutu: 19,32 KB | İndirme Sayısı: 1)
Sub xx()
Dim dic As Object, dic1 As Object, dic2 As Object
Dim i As Long, sonNokta As Byte, parcaal
Dim degerA As String, degerB As String
Dim say As Long
Set dic = CreateObject("Scripting.Dictionary")
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Sayfa1")
.Range("G2:J" & Rows.Count).ClearContents
son = .Cells(Rows.Count, 1).End(3).Row + 1
For i = 3 To 30
degerA = CStr(.Cells(i, 1).Value)
degerB = CStr(.Cells(i, 2).Value)
Do While .Cells(i, 1).Value = .Cells(i + 1, 1).Value
If Not dic1.Exists(degerA) Then
sonNokta = InStrRev(CStr(.Cells(i + 1, 2).Value), ".") - 1
If sonNokta > 0 Then
parcaal = Format(Replace(Mid(.Cells(i + 1, 2).Value, 1, sonNokta), ".", ":"), "dd.mm.yyyy hh:mm:ss")
End If
dic2(parcaal) = parcaal
End If
i = i + 1
Loop
If dic2.Count > 0 Then
say = say + 1
.Cells(say + 2, "G").Value = degerA + 0
.Cells(say + 2, "H").Value = degerB
.Cells(say + 2, "i").Value = bubble_sort(dic2.Keys())
.Cells(say + 2, "j").Value = .Cells(say + 2, "i").Value
.Range("i:j").NumberFormat = "dd.mm.yyyy hh:mm.ss"
Set dic2 = CreateObject("Scripting.Dictionary")
End If
Next
End With
MsgBox "Bitti"
Set dic = Nothing: Set dic1 = Nothing: Set dic2 = Nothing
End SubFunction bubble_sort(dict2)
Dim q As Long, w As Long
For q = 0 To UBound(dict2, 1) - 1
For w = q To UBound(dict2, 1)
If dict2(q) > dict2(w) Then
temp = dict2(q)
dict2(q) = dict2(w)
dict2(w) = temp
End If
Next
Next
bubble_sort = dict2(0)
End Function