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

Katılım
19 Mart 2006
Mesajlar
140
Beğeniler
0
Excel Vers. ve Dili
Excel 2007 - Türkçe
#1
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,589
Beğeniler
394
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#6
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
Beğeniler
0
Excel Vers. ve Dili
Excel 2007 - Türkçe
#7
Çözüldü...Yardımlarınız için çok teşekkürler...
 
Üst