(08/11/2020, 00:19)berduş yazdı: [ -> ]Ama her seyi de benden beklemeyin @feraz bey)
TrhDonsEski = Day(Trh) yerine TrhDonsEski = format(Trh, "dd") yazin olur biter
Ben yazarımda üye bilmezse diye aydım abey
Daha sırada hh:mm:nn burdaki nn neden ss değil diye soracaktım
Daha önce bildiğim kadarıyla salise içindi nn yanlış hatırlamıyorsam.
(08/11/2020, 00:30)feraz yazdı: [ -> ]Daha sırada hh:mm:nn burdaki nn neden ss değil diye soracaktım
Daha önce bildiğim kadarıyla salise içindi nn yanlış hatırlamıyorsam.
o konuda haklisiniz saniye kismi dikkatimden kacmis olabilir.
Yarin uygun bir zamanda kontrol etmeye çalışırım
Gifi inceleyince farkettim saniye yerine de dakikayi yazmis, nn dakika yerine kullaniliyordu aklim saniyeye gitmis. orasi dedigin8z gibi ss olmali;
hh:mm:ss seklinde duzeltilmeli
(07/11/2020, 23:17)feraz yazdı: [ -> ]El birliği ile bitireceğiz inşAllah
![[Resim: do.php?img=10587]](https://resim.accesstr.net/do.php?img=10587)
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?
(08/11/2020, 01:49)berduş yazdı: [ -> ] (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?
Abey açığı kapalıyı bilmiyorumda ben mesela A merkez burdaki en küçüğü buldurdum ve çıkanı açık ve kapalıya aynısını eklettim
Diğer B,C lerde aynı yöntemle oldu
Extra sonlarda bir satırda küçük tarihli saat eklemiştim denemek için onu en küçük olarak doğru bulmuştu bana göre heralde verdiğiniz tarihte o olması gerek.
ben en küçüğü bulurken her kod için mesala açık için açık sütununda sayı olanlar içinden en küçüğü buldum
neyse bu saatten sonra çok da önemi kalmadı galiba)
Aklımda kaldığı kadarıyla nasıl yaptığımı anlatayım.
Son satıra kadar dönhü yaptım.
Bu döngü çalışırken Merkezi(B sütun) yerine gelince do while ile tekrar döngüye sokup dictionarye aldırdım A sütunundaki verilerin benzersiz olana kadar.Döngüdeykende B sütununu tarih ve saat olarak diziye aldırdım.Bu dizileride sıralama koduna yolladı.Sonunsada sıralanınca ilk eleman en küçük olunca onu eklettim ilgili sütunlara.
(08/11/2020, 02:13)berduş yazdı: [ -> ]ben en küçüğü bulurken her kod için mesala açık için açık sütununda sayı olanlar içinden en küçüğü buldum
neyse bu saatten sonra çok da önemi kalmadı galiba)
Bilmiyorum abey biz zor işlerle uğraşıyoruz.En kestirme yol aslında verileri kodla başka sayfaya aktarıp orda sıralatıp vs... işlem yapmak daha kolaydı normali.
Neyse artık yanlışlık felan varsa engin abey yazar .
Daha öncede dediğim gibi hala anlamadım olayı neden açık ve kapalı olaylar için tarih ve saatler aynı.