• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Rapor Almak, Takım Çizelgesinden

  • Konbuyu başlatan Konbuyu başlatan 1Al2Ver
  • Başlangıç tarihi Başlangıç tarihi
1Al2Ver

1Al2Ver

Katılım
5 Kasım 2007
Mesajlar
4,727
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
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.
 

Ekli dosyalar

Merhaba,

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

Teşekkür ederim.
 
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
 
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.
 

Ekli dosyalar

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
Genişletmek için tıkla ...


keşke şunu en başta söyleseydiniz,
 
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.
Genişletmek için tıkla ...
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
 
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.
 
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.
 
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.
 
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.
 
hocam YUSUF44 beyin çözümü oldu bildiğim kadarıyla. yeniden yapmaya gerek var mı ?
 
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.
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst