Yan sayfadan veri alma.

sward175 · 5 Ağustos 2019

Herkese Merhabalar,

Ekli dosyada 1 aylık çalışma programı yazıyorum.
Çalışma çizelgesi sayfasına haftalık olarak çalışma çizelgesi oluşturmak için yardımlarınızı rica ederim.
Saygılarımla,
sward175

YUSUF44 · 5 Ağustos 2019

Aşağıdaki makroyu deneyiniz:

PHP:

Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Çizelgesi")

songun = s2.Cells(Rows.Count, "A").End(3).Row
sonper = s1.Cells(Rows.Count, "B").End(3).Row - 19

s2.[C6:R53].ClearContents

For gun = 6 To 48 Step 7
    ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
    var1 = 0: var2 = 0: var3 = 0: var4 = 0: var5 = 0: var6 = 0: var7 = 0
    
    sut = WorksheetFunction.Match(s2.Cells(gun, "A"), s1.[A3:AG3], 0)
    For kisi = 4 To sonper
        If s1.Cells(kisi, "B") <> "" Then
            If s1.Cells(kisi, sut) = "HT" Then
                s2.Cells(gun + ht, "J") = s1.Cells(kisi, "B")
                ht = ht + 1
            End If
            If s1.Cells(kisi, sut) = "Yİ" Then
                s2.Cells(gun + yi, "K") = s1.Cells(kisi, "B")
                yi = yi + 1
            End If
            If s1.Cells(kisi, sut) = "VD" Then
                s2.Cells(gun + vd, "L") = s1.Cells(kisi, "B")
                vd = vd + 1
            End If
            If s1.Cells(kisi, sut) = "R" Then
                s2.Cells(gun + r, "M") = s1.Cells(kisi, "B")
                r = r + 1
            End If
            If s1.Cells(kisi, sut) = "Mİ" Then
                s2.Cells(gun + mi, "N") = s1.Cells(kisi, "B")
                mi = mi + 1
            End If
            If s1.Cells(kisi, sut) = "RT" Then
                s2.Cells(gun + rt, "O") = s1.Cells(kisi, "B")
                rt = rt + 1
            End If
            If s1.Cells(kisi, sut) = "Üİ" Then
                s2.Cells(gun + ui, "P") = s1.Cells(kisi, "B")
                ui = ui + 1
            End If
            If s1.Cells(kisi, sut) = "Bİ" Then
                s2.Cells(gun + bi, "Q") = s1.Cells(kisi, "B")
                bi = bi + 1
            End If
            If s1.Cells(kisi, sut) = "Öİ" Then
                s2.Cells(gun + oi, "R") = s1.Cells(kisi, "B")
                oi = oi + 1
            End If
            
            If s1.Cells(kisi, sut) = s2.[C5] Then
                s2.Cells(gun + var1, "C") = s1.Cells(kisi, "B")
                var1 = var1 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[D5] Then
                s2.Cells(gun + var2, "D") = s1.Cells(kisi, "B")
                var2 = var2 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[E5] Then
                s2.Cells(gun + var3, "E") = s1.Cells(kisi, "B")
                var3 = var3 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[F5] Then
                s2.Cells(gun + var4, "F") = s1.Cells(kisi, "B")
                var4 = var4 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[G5] Then
                s2.Cells(gun + var5, "G") = s1.Cells(kisi, "B")
                var5 = var5 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[H5] Then
                s2.Cells(gun + var6, "H") = s1.Cells(kisi, "B")
                var6 = var6 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[I5] Then
                s2.Cells(gun + var7, "I") = s1.Cells(kisi, "B")
                var7 = var7 + 1
            End If
        End If
    Next
Next
                
End Sub

sward175 · 5 Ağustos 2019

YUSUF44,
Çok Çok ama Çok Teşekkürler ediyorum.
Sağ olun,
sward175

sward175 · 20 Ağustos 2019

Herkese Merhabalar,
Sayın, YUSUF44, Arkadaşımızın vermiş olduğu kodlar gayet güzel çalışıyor.
Çalışan sayısının artmasıyla formatı değiştirmem gerekti.
Bu şekli ile makroya yardım edecek arkadaşlara teşekkürlerimi sunarım.
Saygılarımla,
sward175

YUSUF44 · 20 Ağustos 2019

Aşağıdaki makroyu deneyiniz:

PHP:

Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN45").ClearContents
s2.Range("C50:AN89").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 47 Step 44
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AG3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 3) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 4) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 5) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub

sward175 · 20 Ağustos 2019

Sayın, YUSUF44,
Teşekkürlerimi bir borç bilirim.
Sağ olun.
sward175

sward175 · 24 Aralık 2019

Herkese Merhabalar,
Sayın, YUSUF44, Arkadaşımızın vermiş olduğu kodlar ile çalışıyorum.
Çalışan sayısının artmasıyla formata değişiklik gerekti.
Ekteki biçimi ile makroya yardım edecek arkadaşlara teşekkürlerimi sunarım.
Saygılarımla,
sward175

YUSUF44 · 24 Aralık 2019

Sanıyorum sorun sadece döngü aralığının değiştirilmesiyle ilgili. Bunu sizin de yapabilmeniz lazımdı aslında, biraz dikkat ve gayretle yapabilirdiniz bence.

Aşağıdaki makro uygun mu?

PHP:

Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN65").ClearContents
s2.Range("C70:AN129").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AG3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 3) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 4) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 5) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub

sward175 · 24 Aralık 2019

Sayın, YUSUF44.
Çok teşekkür ederim.
Makro bilgim sıfıra yakın olduğu için yardım ihtiyacı duyuyorum, Uyarınızı anladım daha fazla satırlı olursa halledeceğim galiba.
Yine de çok teşekkür ediyorum.
Sağ Olun, sward175

sward175 · 25 Aralık 2019

YUSUF44 Bey,
Kodu uygulayınca anladım gözümden kaçmış vardiya adedini 4 yapınca sütun kayması oldu, Bu konu hakkında yardımınızı rica edebilir miyim ?,
Saygılarımla,
sward175

YUSUF44 · 26 Aralık 2019

Sadece o değil, ayrıca VD isimli sütununuzu da iptal etmişsiniz. Lütfen bu değişikliklere dikkat edelim, hatanın nerde olduğunu buluncaya kadar yarım saat uğraştım.

Aşağıdaki makroyu deneyiniz:

PHP:

Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN65").ClearContents
s2.Range("C70:AN129").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0: var4 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AN3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 4) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 5) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 3) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 3) = s1.Cells(kisi, "B")
                    var4 = var4 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub

sward175 · 26 Aralık 2019

Sayın, YUSUF44,
Çok güzel gayet iyi çalışıyor.
Her şey için çık çok teşekkür ederim.
Saygılarımla,
sward175

sward175 · 31 Aralık 2019

Herkese Günaydın.
Sayın, YUSUF44 Arkadaşımızın yardımı ile geliştirmeye çalıştığım vardiya sayfasından çalışma listesi sayfasına veri aktarırken makroda aşağıdaki hatayı alıyorum.
Konu hakkında yardımlarınızı rica ederim.
Saygılarımla,
sward175

sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AW3], 0)

YUSUF44 · 31 Aralık 2019

Çalışma Listesi sayfasında Kasım ayına ait günler varken, Vardiya sayfasında Ocak ayının verileri olmasından kaynaklanıyor olabilir mi?

sward175 · 31 Aralık 2019

Merhaba, YUSUF44,
Tarihleri değiştirdim ama gene aynı hatayı listenin bir bölümünü dizerek verdi.
sward175

YUSUF44 · 31 Aralık 2019

Farkında mısınız bilmiyorum ama bir önceki dosyanızda vardiya sayınızın artması nedeniyle kodlarda günceleme yapmıştık. Şimdi bir önceki dosyanızla şimdiki dosyanızı karşılaştırdığımda görüyorum ki yine değişiklik yapmışsınız. Bir önceki dosyanızda 4 vardiya 8 de özel durum varken şimdiki dosyanızda 6 vardiya 9 özel durum var.

Bir önceki durumda vardiya düzeni değişince oluşan hatanın farkındayken şimdi bunu farketmemiş olmanız şaşırtıcı. Kodlarda yeni eklenen sütunlara göre güncelleme yapılması gerekir. Ancak emeğimizin boşa gitmemesi adına bu dosyanın artık son hali olduğuna emin misiniz? Yarın başka vardiya ya da özel durumlar ekleyip çıkartmayacaksınız değil mi?

sward175 · 31 Aralık 2019

Merhaba, Sayın, YUSUF44,
Gerçekten özür dilerim ne diyeyim ki sürekli değişiklik gerektiren bir durum olduğu için sizleri meşgul ediyorum. Hal böyle olunca doğal ki istekler artıyor, Bilesiniz ki bu konuda son isteğimdir yardımınız.
İlginize teşekkür ediyorum.
saygılarımla,
sward175

YUSUF44 · 31 Aralık 2019

Bazı güncellemeleri yapmışsınız ama bazıları eksik kalmış, özellikle for next döngüsünün step yani adım aralığı olmamış, bir de HT ve diğer durumlar için eklenecek sütun sayısını 1 fazla belirlemişsiniz. Onları düzelttim:

PHP:

Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AW65").ClearContents
s2.Range("C70:AW129").ClearContents

For gun1 = 3 To 35 Step 16
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0: var4 = 0: var5 = 0: var6 = 0
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AW3], 0)
        For kisi = 6 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 6) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 7) = s1.Cells(kisi, "B")
                    yi = yi + 1
                    End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 8) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 9) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 10) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 11) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 12) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 13) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 14) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 3) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 3) = s1.Cells(kisi, "B")
                    var4 = var4 + 1
                    End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 4) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 4) = s1.Cells(kisi, "B")
                    var5 = var5 + 1
                    End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 5) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 5) = s1.Cells(kisi, "B")
                    var6 = var6 + 1
                End If
            End If
        Next
    Next
Next         
End Sub

sward175 · 31 Aralık 2019

Sayın, YUSUF44,
Çok teşekkür ediyorum.
Elleriniz dert görmesin.
Kalın sağlıcakla
sward175

Yan sayfadan veri alma.

Özel Üye

Ekli dosyalar

Destek Ekibi

Özel Üye

Özel Üye

Ekli dosyalar

Destek Ekibi

Özel Üye

Özel Üye

Ekli dosyalar

Destek Ekibi

Özel Üye

Özel Üye

Ekli dosyalar

Destek Ekibi

Özel Üye

Özel Üye

Ekli dosyalar

Destek Ekibi

Özel Üye

Ekli dosyalar

Destek Ekibi

Özel Üye

Destek Ekibi

Özel Üye