Şarta Bağlı Değer Bulma,

[gicimi]

Merhaba;

ekteki excel çalışmasında bilgiler yer almaktadır. Desteğinizi ve yardımlarınızı rica ederim. Şartta bağlı bir kaç formül yazılması gerekiyor.
Sayfa1-Sayfa2-Sayfa3 konu ile ilgili tablolar bulunmaktadır.

Açıklamalar;

*Tarih ve Kullanıcı bilgilerine göre saatler arası yapılan başarılı / başarısız iş adeti
*Tarih ve Kullanıcı bilgilerine göre 12:00 ile 13:00 arası yapılan son işin saati
*Tarih ve Kullanıcı bilgilerine göre 13:00 ile 14:00 arası yapılan ilk işin saati
*Tarih ve Kullanıcı bilgileri baz alınarak saatler arası yapılan iş adeti

 

[Ömer BARAN]

Merhaba.

Belge ekte.
.

 

[gicimi]

Merhaba.

Belge ekte.
.

Ömer Bey Merhaba;

Çok teşekkür ederim yardımlarınız için. Makro olarak da yapılabilir mi hızlı sonuçlar almak adına yaklaşık 50.000 - 100.000 arası veri ile hesaplama yapılacak makro konusunda da yardımcı olabilir misiniz. Teşekkürler

 

[Ziynettin]

Merhaba,
Saatlik İş Sayıları sayfası için makro olarak çözüm.

Sub Saatlik_İş_Sayıları()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Saatlik İş Sayıları")
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Z = TimeValue(Now)
    a = s1.Range("A2:E" & s1.Cells(Rows.Count, 1).End(3).Row)
    s2.Range("A2:O" & Rows.Count).ClearContents
    
        For i = 1 To UBound(a)
            krt = a(i, 1) & "|" & Format(a(i, 4), "hh")
            d(krt) = d(krt) + 1
            d1(a(i, 1)) = i
        Next i
        
        ReDim c(1 To d1.Count, 1 To 2)
        For Each v In d1.keys
            say = say + 1
            c(say, 1) = a(d1(v), 1)
            c(say, 2) = Format(a(d1(v), 3), "dd.mm.yyyy")
        Next v
        s2.[A2].Resize(d1.Count, 2) = c
        
    Erase c
    On Error Resume Next
    b = s2.Range("A1:O" & s2.Cells(Rows.Count, 1).End(3).Row)
    ReDim c(1 To UBound(b), 1 To 13)
        For i = 2 To UBound(b)
            For j = 3 To UBound(b, 2)
                krt = b(i, 1) & "|" & Left(b(1, j), 2)
                If Not IsEmpty(d(krt)) Then
                    c(i - 1, j - 2) = d(krt)
                    c(i - 1, 1) = c(i - 1, 1) + d(krt)
                Else
                    c(i - 1, j - 2) = 0
                End If
            Next j
        Next i
    s2.[C2].Resize(UBound(b) - 1, 13) = c
MsgBox "İşlem tamam." & vbLf & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub

D1 ve O1 deki saatler yoksa kodu çalıştırmadan saatleri yazınız.

 

[gicimi]

Makro için çok teşekkür ederim.

 

[gicimi]

Merhaba.

Belge ekte.
.

Merhaba Ömer Bey;

Öğle arası sayfasına ilk işe başlama ve son işi kapatma tarihlerini nasıl ekleyebilirim yardımcı olabilir misiniz. Mümkünse formüller İle ilgili bir açıklama yazabilir misiniz. Teşekkür ederim.

 

[gicimi]

Merhaba,
Saatlik İş Sayıları sayfası için makro olarak çözüm.

Sub Saatlik_İş_Sayıları()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Saatlik İş Sayıları")
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Z = TimeValue(Now)
    a = s1.Range("A2:E" & s1.Cells(Rows.Count, 1).End(3).Row)
    s2.Range("A2:O" & Rows.Count).ClearContents
    
        For i = 1 To UBound(a)
            krt = a(i, 1) & "|" & Format(a(i, 4), "hh")
            d(krt) = d(krt) + 1
            d1(a(i, 1)) = i
        Next i
        
        ReDim c(1 To d1.Count, 1 To 2)
        For Each v In d1.keys
            say = say + 1
            c(say, 1) = a(d1(v), 1)
            c(say, 2) = Format(a(d1(v), 3), "dd.mm.yyyy")
        Next v
        s2.[A2].Resize(d1.Count, 2) = c
        
    Erase c
    On Error Resume Next
    b = s2.Range("A1:O" & s2.Cells(Rows.Count, 1).End(3).Row)
    ReDim c(1 To UBound(b), 1 To 13)
        For i = 2 To UBound(b)
            For j = 3 To UBound(b, 2)
                krt = b(i, 1) & "|" & Left(b(1, j), 2)
                If Not IsEmpty(d(krt)) Then
                    c(i - 1, j - 2) = d(krt)
                    c(i - 1, 1) = c(i - 1, 1) + d(krt)
                Else
                    c(i - 1, j - 2) = 0
                End If
            Next j
        Next i
    s2.[C2].Resize(UBound(b) - 1, 13) = c
MsgBox "İşlem tamam." & vbLf & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub

D1 ve O1 deki saatler yoksa kodu çalıştırmadan saatleri yazınız.

Merhaba Ziynettin Bey,

Kullanıcı ve tarih sütunları alt alta değişerek devam etmektedir. Makroyu çalıştırdığımda sadece 8 satırı baz almaktadır. Tam sayfa olarak güncellenebilir mi_?
Kullanıcı Tarih
20010 04.06.2018
20011 04.06.2018
20012 04.06.2018
1A1 04.06.2018
1A2 04.06.2018
1A3 04.06.2018
1A4 04.06.2018
1A5 04.06.2018