Rapor Almak, Takım Çizelgesinden

1Al2Ver · 8 Nisan 2020

Merhaba,

"TAKIM_LİST" sayfasında ; "A1:CK33" aralığında 6 adet Takım Çizelgesi var.

"RAPOR" sayfasında; "B1" açılır kutudan seçilen isime ait verileri,

Günlere (F3:L3) ve Şehirlere (E4:E33) göre, "TAKIM_LİST" sayfasından, Ek'li dosyada örnek tablodaki gibi almak istiyorum,

Teşekkür ederim.

1Al2Ver · 15 Nisan 2020

Merhaba,

Konuyla ilgili çözüm arayışım devam etmektedir,

Teşekkür ederim.

YUSUF44 · 15 Nisan 2020

Aşağıdaki makroyu rapor sayfasının kod bölümüne yapıştırıp deneyiniz. B1 hücresini değiştirdiğinizde istediğiniz işlemi yapar. Ancak TAkım sayfasındaki b3366 gibi ifadelerin ne olacağını bilemedim:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Set s1 = Sheets("TAKIM_LİST")
sonsut = s1.Cells(1, Columns.Count).End(xlToLeft).Column
If Selection.Count > 1 Then Exit Sub
[E4:M33].ClearContents
If Target = "" Then Exit Sub

If WorksheetFunction.CountIf(s1.Range(s1.Cells(1, "A"), s1.Cells(1, sonsut)), Target) = 0 Then
    [E4:M33].ClearContents
    MsgBox Target & " adlı personelin görevi bulunmamaktadır.", vbInformation
    Exit Sub
Else
    For takim = 2 To 77 Step 15
        If WorksheetFunction.CountIf(s1.Range(s1.Cells(1, takim + 1), s1.Cells(1, takim + 12)), Target) > 0 Then
            For kisi = takim + 1 To takim + 12
                If s1.Cells(1, kisi) = Target Then
                    sonil = WorksheetFunction.Max(2, s1.Cells(Rows.Count, takim).End(3).Row)
                    For il = 2 To sonil
                        If WorksheetFunction.CountIf([E3:E33], s1.Cells(il, takim)) = 0 Then
                            yeni = WorksheetFunction.Max(4, Cells(Rows.Count, "E").End(3).Row + 1)
                            Cells(yeni, "E") = s1.Cells(il, takim)
                        End If
                        
                        If s1.Cells(il, kisi) <> "" Then
                            If s1.Cells(il, kisi) = "h1" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Range("F" & sat & ":L" & sat) = "h1"
                            ElseIf Left(s1.Cells(il, kisi), 2) = "PT" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "F") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "SAL" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "G") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "ÇAR" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "H") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "PER" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "I") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "CU" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "J") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "CT" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "K") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "Pz" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "L") = s1.Cells(il, kisi)
                            End If
                        End If
                    Next
                End If
            Next
        End If
    Next
End If
End Sub

1Al2Ver · 15 Nisan 2020

Sayın YUSUF44 merhaba,

Öncelikle ilginiz ve çözüm emekleriniz için çok teşekkür ederim, sağ olun,

b3366, abc, bel1 ve benzeri ifadeler, aynı h1 gibi bir özelliği yok, ilgili hücrelere farklı formatlarda ( bazen metin, bazen rakam, bazen hem metin hem rakam vb )

Önerilen koddaki "h1" sabit olmamalı,

Örneğin B1 "Ali" olsaydı ;

İstanbul için, tüm günlerde, d4
İzmir için, tüm günlerde, d5
Mersin için, ÇARŞAMBA sütununa, ÇAR (Azm-1)
Adana için, tüm günlerde, d6 ifadeleri yer almalı,

Örneğin B1 "Ayşe" olsaydı ;

Bilecik için, PAZARTESİ sütununa, PT (snm-1)
Balıkesir için, tüm günlerde, b3366
Konya için, PERŞEMBE sütununa, PER (xxx-1)
Kırşehir için, PAZARTESİ sütununa, PT (ops-1)

AMACIM ;

"B1" den seçim yapılan isme ait oluşacak tabloda, özel işareti olanları ( PT, SAL, ÇAR vb ) kendi sütunlarına (PAZARTESİ, SALI, ÇARŞAMBA vb),
diğerlerini haftanın hergünü'ne yazmak

Tekrar teşekkür ederim.

hmtstc · 15 Nisan 2020

merhaba,

ekteki dosyayı inceleyiniz

hmtstc · 15 Nisan 2020

1Al2Ver' Alıntı:
AMACIM ;

"B1" den seçim yapılan isme ait oluşacak tabloda, özel işareti olanları ( PT, SAL, ÇAR vb ) kendi sütunlarına (PAZARTESİ, SALI, ÇARŞAMBA vb),
diğerlerini haftanın hergünü'ne yazmak

keşke şunu en başta söyleseydiniz,

hmtstc · 15 Nisan 2020

yeni versiyon, gün ibaresi yoksa her güne yazar, gün ibareleri 2 harf ile kısıtlıdır.

YUSUF44 · 15 Nisan 2020

1Al2Ver' Alıntı:
Sayın YUSUF44 merhaba,

Öncelikle ilginiz ve çözüm emekleriniz için çok teşekkür ederim, sağ olun,

b3366, abc, bel1 ve benzeri ifadeler, aynı h1 gibi bir özelliği yok, ilgili hücrelere farklı formatlarda ( bazen metin, bazen rakam, bazen hem metin hem rakam vb )

Önerilen koddaki "h1" sabit olmamalı,

Örneğin B1 "Ali" olsaydı ;

İstanbul için, tüm günlerde, d4
İzmir için, tüm günlerde, d5
Mersin için, ÇARŞAMBA sütununa, ÇAR (Azm-1)
Adana için, tüm günlerde, d6 ifadeleri yer almalı,

Örneğin B1 "Ayşe" olsaydı ;

Bilecik için, PAZARTESİ sütununa, PT (snm-1)
Balıkesir için, tüm günlerde, b3366
Konya için, PERŞEMBE sütununa, PER (xxx-1)
Kırşehir için, PAZARTESİ sütununa, PT (ops-1)

AMACIM ;

"B1" den seçim yapılan isme ait oluşacak tabloda, özel işareti olanları ( PT, SAL, ÇAR vb ) kendi sütunlarına (PAZARTESİ, SALI, ÇARŞAMBA vb),
diğerlerini haftanın hergünü'ne yazmak

Tekrar teşekkür ederim.

Hem istediğiniz işlemi hem de önceki kodda 3 harfli gün isimlerdeki hatayı düzelttim sanıyorum:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Set s1 = Sheets("TAKIM_LİST")
sonsut = s1.Cells(1, Columns.Count).End(xlToLeft).Column
If Selection.Count > 1 Then Exit Sub
[E4:M33].ClearContents
If Target = "" Then Exit Sub

If WorksheetFunction.CountIf(s1.Range(s1.Cells(1, "A"), s1.Cells(1, sonsut)), Target) = 0 Then
    [E4:M33].ClearContents
    MsgBox Target & " adlı personelin görevi bulunmamaktadır.", vbInformation
    Exit Sub
Else
    For takim = 2 To 77 Step 15
        If WorksheetFunction.CountIf(s1.Range(s1.Cells(1, takim + 1), s1.Cells(1, takim + 12)), Target) > 0 Then
            For kisi = takim + 1 To takim + 12
                If s1.Cells(1, kisi) = Target Then
                    sonil = WorksheetFunction.Max(2, s1.Cells(Rows.Count, takim).End(3).Row)
                    For il = 2 To sonil
                        If WorksheetFunction.CountIf([E3:E33], s1.Cells(il, takim)) = 0 Then
                            yeni = WorksheetFunction.Max(4, Cells(Rows.Count, "E").End(3).Row + 1)
                            Cells(yeni, "E") = s1.Cells(il, takim)
                        End If
                        
                        If s1.Cells(il, kisi) <> "" Then
                            If Left(s1.Cells(il, kisi), 2) = "PT" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "F") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 3) = "SAL" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "G") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 3) = "ÇAR" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "H") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 3) = "PER" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "I") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "CU" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "J") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "CT" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "K") = s1.Cells(il, kisi)
                            ElseIf Left(s1.Cells(il, kisi), 2) = "Pz" Then
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Cells(sat, "L") = s1.Cells(il, kisi)
                            Else
                                sat = WorksheetFunction.Match(s1.Cells(il, takim), [E1:E33], 0)
                                Range("F" & sat & ":L" & sat) = s1.Cells(il, kisi)
                            End If
                        End If
                    Next
                End If
            Next
        End If
    Next
End If
End Sub

1Al2Ver · 15 Nisan 2020

Sayın hmtstc, merhaba,

Emekleriniz için teşekkür ederim, aşağıdaki satır hata verdi,

Kod:

 ilsatır = Application.WorksheetFunction.Match(takım.Cells(i, takımsütun), rapor.Range("E1:E33"), 0)

Kod:

Run-time error ; '1004'
WorksheetFunction sınıfının Match özelliği alınamıyor.

1Al2Ver · 15 Nisan 2020

Sayın YUSUF44 merhaba,

Tekrar teşekkür ederim, şu ana kadar yaptığım denemelerde, bir sıkıntıyla karşılaşmadım...

Saygılarımla.

hmtstc · 15 Nisan 2020

eğer denemeyi benim verdiğim dosyada yaptıysanız hata alırsınız. çünkü ben verileri illere rastgele dağıttım. o kişinin o ilde görevi olmayabilir. bu yüzden hata alırsınız. siz verileri doğru yazdıysanız ve hata alıyorsanız o zaman incelerim. ama illeri getirilişini siz ayarlamışsınız, ben olmayan bir ile veri girmiş olabilirim.

1Al2Ver · 15 Nisan 2020

Sayın hmtstc merhaba,

Hem sizin eklediğiniz hem de bendeki dosyada denemeler yaptım, aynı hatayı aldım, belki de ben becerememişimdir...

Sizden ricam, kodu, 4 nolu ekteki dosyaya uyarlayıp, foruma eklemenizdir.

Tekrar teşekkür ederim.

hmtstc · 15 Nisan 2020

hocam YUSUF44 beyin çözümü oldu bildiğim kadarıyla. yeniden yapmaya gerek var mı ?

1Al2Ver · 15 Nisan 2020

Sayın hmtstc merhaba,

Evet, sorunum sayın YUSUF44 tarafından çözüldü,

Benim açımdan, yeniden yapılmaması bir engel teşkil etmiyor,

Sizin emeğinize saygısızlık olmasın ve aşılmaya çalışılan çözüm, yarım kalmasın maksadıyla size dönüş yapmıştım,

Emek ve duyarlığınız için tekrar teşekkür ederim.

Saygılarımla.

hmtstc · 15 Nisan 2020

benim için problem yok olmadıysa düzeltirim, ben problemi buldum, ben her ayı kontrol ettiriyorum bulamadığı için hata veriyordu. sorunu çözdüm teşekkürler geri bildirim için

Rapor Almak, Takım Çizelgesinden

1Al2Ver

Ekli dosyalar

1Al2Ver

YUSUF44

Destek Ekibi

1Al2Ver

Ekli dosyalar

hmtstc

Ekli dosyalar

hmtstc

hmtstc

Ekli dosyalar

YUSUF44

Destek Ekibi

1Al2Ver

1Al2Ver

hmtstc

1Al2Ver

hmtstc

1Al2Ver

hmtstc