VBA ile Ekip listesi oluşturma

[msdemr]

Merhaba,

Elimde ekip1 ve ekip2 olmak üzere 2 farklı sheette tablolar var. tablolarda ilk satırda gün, A sütununda çalışan isimleri var. geriye kalan kesişim hücrelerinde ise çalışan o gün müsaitse "AVBL" yazmakta. son sütunda (AG) ise "toplam çalışma saatleri yer almakta.

Ben "ekip1" sheetindeki tablodaki çalışanları "ekip1 sıralı liste" sheetine ilgili günlerde müsait olan çalışanları toplam çalışma saatlerine göre azdan çoğa olacak şekilde,
"ekip2" sheetindeki tablodaki çalışanları "ekip2 sıralı liste" sheetine ilgili günlerde müsait olan çalışanları toplam çalışma saatlerine göre azdan çoğa olacak şekilde tablo halinde getirmek istiyorum. Bunu bir vba kodu ile yapmak mümkün mü? İlgili dosyayı ekliyorum.

Şimdiden yardımınız için teşekkürler.

 

[muygun]

Merhaba;
Doğru anladıysam eki deneyin.
İyi çalışmalar.

 

[msdemr]

Merhaba;
Doğru anladıysam eki deneyin.
İyi çalışmalar.

Merhaba,
öncelikle ilgilendiğiniz için teşekkürler. Kodu çalıştırmaya çalıştığımda aşağıdaki hatayı aldım.

Kodu incelediğimde "i" harfiyle alakalı bi hata olabilir mi onu düşündüm. tüm "y" karakterleri "i"ye çevirdiğimde çalıştı. fakat her hangi bir aksiyon olmadı tabloda.


diğer bir konu ise sanırım ben anlatamamışım istediğimi. Koda biraz baktım ama ekip1 ve ekip2 tablosunda "AVBL" yazan kişilerin ismini çalışma saatine göre sıralamak istiyorum ben. kod içerisinde buna dair bir şey göremedim. ben anlayamamış da olabilirim.
Sonuç olarak macro istediğimi sağlamıyor şuan sizde listeliyormuydu bilmiyorum ama bende yapmıyor.

istediğim tablonun ekip1 ve ekip2 için ilk 3'er günü aşağıda yer almakta.

 

[BaY_KaPTaN]

Merhaba,
öncelikle ilgilendiğiniz için teşekkürler. Kodu çalıştırmaya çalıştığımda aşağıdaki hatayı aldım.Ekli dosyayı görüntüle 249603

Kodu incelediğimde "i" harfiyle alakalı bi hata olabilir mi onu düşündüm. tüm "y" karakterleri "i"ye çevirdiğimde çalıştı. fakat her hangi bir aksiyon olmadı tabloda.
Ekli dosyayı görüntüle 249605

diğer bir konu ise sanırım ben anlatamamışım istediğimi. Koda biraz baktım ama ekip1 ve ekip2 tablosunda "AVBL" yazan kişilerin ismini çalışma saatine göre sıralamak istiyorum ben. kod içerisinde buna dair bir şey göremedim. ben anlayamamış da olabilirim.
Sonuç olarak macro istediğimi sağlamıyor şuan sizde listeliyormuydu bilmiyorum ama bende yapmıyor.

istediğim tablonun ekip1 ve ekip2 için ilk 3'er günü aşağıda yer almakta.

Ekli dosyayı görüntüle 249606

Merhaba.
ai olarak değil de aı olarak deneyin.
Ben dosyayı indirdim, kodlarda aı olarak gördüm.

 

[msdemr]

Merhaba.
ai olarak değil de aı olarak deneyin.
Ben dosyayı indirdim, kodlarda aı olarak gördüm.

Çalışıyor yani hata vermiyor. ama "ekip1 sıralı liste" ve "ekip2 sıralı liste" tablolarında bir değişiklik olmuyor.

 

[BaY_KaPTaN]

Çalışıyor yani hata vermiyor. ama "ekip1 sıralı liste" ve "ekip2 sıralı liste" tablolarında bir değişiklik olmuyor.

@muygun 'in paylaştığı dosyayı aynen indirip butona bastım çalışıyor.

Eğer listelerde, sayfa isminde değişiklik yaptıysanız eğer çalışmayabilir.

Yeniden indirip kontrol edin değişiklik yapmadan.

Bende grünen ekran görüntüsü;

 

[muygun]

365 uyumsuzluğu olabilir.
(Ofis 365 kullanmadığım için test edemiyorum)

 

[veyselemre]

Sub test()
    Dim myVal, myVal2, liste, rng, i, ii, sat, sH, sh2(), s
    sh2 = Array("ekip1 sıralı liste", "ekip2 sıralı liste")
    s = 0
    For Each sH In Array(Sheets("ekip1"), Sheets("ekip2"))
        Set rng = sH.Range("A1:AG" & sH.Cells(Rows.Count, 1).End(3).Row)
        myVal2 = rng.Value
        rng.Sort key1:=sH.Range("AG1"), Header:=xlYes
        myVal = rng.Value
        rng.Value = myVal2
        ReDim liste(1 To UBound(myVal), 1 To 31)
        For i = 1 To 31
            sat = 1
            For ii = 1 To UBound(myVal)
                If myVal(ii, i + 1) = "AVBL" Then
                    liste(sat, i) = myVal(ii, 1)
                    sat = sat + 1
                End If
            Next ii
        Next i
        With Sheets(sh2(s))
            .Range("2:" & Rows.Count).ClearContents
            .Range("A2").Resize(UBound(liste), 31).Value = liste
        End With
        s = s + 1
    Next sH
End Sub