• Merhaba, 22 Ocak 2020 Çarşamba günü sabah 08:00 ile 12:00 saatleri arasında forumun bulunduğu sunucuda genel bakım çalışması yapılacaktır.
    Bu sürenin tamamında olmasa da bir süreliğine forum geçici olarak erişilemez olacaktır. Bilgilerinize

ÇOK KOŞULA GÖRE BENZERSİZ VERİ SAYMA

Katılım
19 Mart 2006
Mesajlar
140
Excel Vers. ve Dili
Excel 2007 - Türkçe
Merhaba arkadaşlar,
burada da, google da da çok arattım fakat bir türlü bulamadım. yardımlarınıza ihtiyacım var. Şöyle ki;

TCNO------TARİH------GÜN-------ÇALIŞMA SAATİ
111----- 01.01.2019----Ç-------- 07:00 - 12:00
111-----01.01.2019-----Ç--------18:00 - 23:59

222------01.01.2019-----Ç--------08:00 - 17:00
111-----02.01.2019----Ç--------07:00 - 12:00
111-----02.01.2019----Ç--------18:00 - 23:59

222-----02.01.2019------Ç--------08:00 - 17:00
111-----03.01.2019-----Ç-------07:00 - 12:00
111-----03.01.2019-----Ç-------18:00 - 23:59

222-----03.01.2019------Ç--------08:00 - 17:00

Böyle bir tablom var. Burada GÜN sütununu saydırmak istiyorum TCNO ve TARİH sütunlarını da dikkate alarak. Çünkü gün içinde 2 defa işe geliniyor. Sonuç şöyle olmalı;

TARİH: >=01.01.2019 İLE <=31.01.2019 ARASINDA

TCNO GÜN
111 3 (HESAPLANMASI İSTENEN DEĞER)
222 3 (HESAPLANMASI İSTENEN DEĞER)

Yardımlarınız için şimdiden teşekkürler...
 
Son düzenleme:

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
21,865
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız linktedir.:cool:

DOSYAYI INDIR

Kod:
Option Base 1
Sub benzersiz_59()
Dim liste(), z As Object, i As Long, n As Long, myarr(), deg, myarr2()
Range("E2:G" & Rows.Count).ClearContents
liste = Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row).Value
Set z = CreateObject("scripting.dictionary")
ReDim myarr(1 To UBound(liste), 1 To 3)
For i = 1 To UBound(liste)
    deg = liste(i, 1) & Format(liste(i, 2), "dd.mm.yyyy")
    If Not z.exists(deg) Then
        n = n + 1
        z.Add (deg), n
        myarr(n, 1) = liste(i, 1)
        myarr(n, 2) = 1
        If liste(i, 3) = "Ç" Then myarr(n, 3) = "Ç"
        If liste(i, 3) = "R" Then myarr(n, 3) = "R"
    End If
    deg = ""
Next
Set z = Nothing
Set z = CreateObject("scripting.dictionary")
ReDim myarr2(1 To n, 1 To 3)
n = 0
For i = 1 To UBound(myarr)
    deg = myarr(i, 1) & myarr(i, 2) & myarr(i, 3)
    If deg <> "" Then
        If Not z.exists(deg) Then
            n = n + 1
            z.Add (deg), n
            myarr2(n, 1) = myarr(i, 1)
            If myarr(i, 3) = "Ç" Then myarr2(n, 3) = "Ç"
            If myarr(i, 3) = "R" Then myarr2(n, 3) = "R"
        End If
        myarr2(z.Item(deg), 2) = myarr2(z.Item(deg), 2) + 1
    End If
Next i
MsgBox n
Range("E2").Resize(n, 3) = myarr2
MsgBox "İşlem tamamlanmıştır."
End Sub
 
Katılım
19 Mart 2006
Mesajlar
140
Excel Vers. ve Dili
Excel 2007 - Türkçe
Çözüldü...Yardımlarınız için çok teşekkürler...
 
Üst