Benzersiz verilerin saniyelerini makro ile topla

[şehiriçi]

Merhaba Arkadaşlar ,
Ekte ki dosyamda A sütunundaki Plakaların C sütunundaki değerlerin sadece saniyelerini toplayıp , yine toplamıda A sütunundaki Plaka sayısına bölünmesini mümkünse scripting dictionary ile veya dizi yöntemiyle istiyorum , ilginize teşekkürler.

 

[şehiriçi]

Selam Arkadaşlar , ben E sütununa plakaları dizi yöntemiyle yazdırdım .Ama F sütununa bu Plakaların karşısın da ki yani C sütunundaki saatlerin sadece saniyelerinin toplamının plaka sayısına bölümünü de F sütununa yazdırmak istiyorum.Bu kısım benim kapasitemi aşıyor ,desteğiniz için ,teşekkürler.

 

[ÖmerFaruk]

Mevcut kodlar yerine aşağıdakiin kullanabilirsiniz.

Option Explicit
Sub BenzersizYeni()
   Dim VeriArr As Variant, ItemArr, Dict1 As Object, i As Integer
   Sheets("Sayfa1").Range("E:F").ClearContents
   Sheets("Sayfa1").Range("E1") = "Plaka"
   Sheets("Sayfa1").Range("F1") = "Saniye Toplamı / Sefer Sayısı"
  
   VeriArr = Sheets("Sayfa1").Range("A2:C" & Sheets("Sayfa1").Cells(Rows.Count, 1).End(3).Row)
   Set Dict1 = CreateObject("Scripting.Dictionary")
   For i = LBound(VeriArr, 1) To UBound(VeriArr, 1)
      If Not Dict1.Exists(VeriArr(i, 1)) Then
         Dict1.Add VeriArr(i, 1), Second(VeriArr(i, 3)) & "/" & 1
      Else
         ItemArr = Split(Dict1(VeriArr(i, 1)), "/")
         Dict1(VeriArr(i, 1)) = Second(VeriArr(i, 3)) + ItemArr(0) & "/" & ItemArr(1) + 1
      End If
   Next i
   For i = 0 To Dict1.Count - 1
      Sheets("Sayfa1").Range("E2").Offset(i, 0) = Dict1.Keys()(i)
      Sheets("Sayfa1").Range("E2").Offset(i, 1) = Dict1.Items()(i)
   Next i
   Set Dict1 = Nothing: Erase VeriArr: Erase ItemArr: i = Empty
End Sub

 

[şehiriçi]

ÖmerFaruk by ,istediğim bir eksikle olmuş emeğinize sağlık.
eksik olan ise, F sütununa mesela 141/4 şeklinde yazması değil sonucu vermesi yani 141 i 4 e bölersek 35,25 sn olması idi
amacım ortalama saniyeyi bulmaktı , sağlıkla kalın..

 

[ÖmerFaruk]

Sheets("Sayfa1").Range("E2").Offset(i, 1) = Dict1.Items()(i)

Bu satırı aşağıdakiyle değiştirin. Denemeden yolluyorum.

Sheets("Sayfa1").Range("E2").Offset(i, 1) =Split(Dict1.Items()(i), "/")(0)/Split(Dict1.Items()(i), "/")(1)

 

[şehiriçi]

Verdiğiniz kodu deneyin ama sonuçta plakaları da sildi toplam durdurmade değilim ben mi yanlış kontrol eder misiniz

 

[ÖmerFaruk]

Fazladan bir şeyler değiştirmişsiniz. Son For-Next döngüsü aşağıdaki gibi olacak.
Ayrıca F sütunun formatını Sayı olarak seçin, Ondalık kısmı virgülden sonra 2 hane tutun.

   For i = 0 To Dict1.Count - 1
      Sheets("Sayfa1").Range("E2").Offset(i, 0) = Dict1.Keys()(i)
      Sheets("Sayfa1").Range("E2").Offset(i, 1) = Split(Dict1.Items()(i), "/")(0) / Split(Dict1.Items()(i), "/")(1)
   Next i

Yukarıdaki haliyle sonuç görüntüsü

 

[şehiriçi]

Teşekkürler ÖmerFaruk üstadım .istediğim sonuç bu idi ,son halini de ekliyorum , iyi günler