(07/11/2020, 23:17)feraz yazdı: El birliği ile bitireceğiz inşAllah
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 Sub
Function 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
@
feraz bey sonucu yanlış hesaplamıyor mu?
mesela 10609708 için açık min=02-SEP-20 10:49:37 yani 2.9.2020 iken sizin sonucunuz--> 1.09.2020 10:49:37
hesaplar açık ve kapalıdan bağımsız yapılmış sanki
ben mi yanlış anladım acık/kapalı durumundan bağımsız mı olacak sonuçlar?