Tabloları tek sayfada birleştirme

[ordulu82]

Selamlar
Excel dosyamda ocak-aralık ayları arasında sayfalar var. burada kişiler ve çalışma saatleri yer alıyor. yapmak istediğim tüm sayfaları buraya birleştirsin. aynı kişi farklı aylarda yer aldığından listeye çalışma saatleri toplanarak eklenebilir mi

 

[Korhan Ayhan]

Hangi ofis sürümünü ve dilini kullanıyorsunuz?

 

[cemshan]

Korhan Hocam Aynı problem bende var Excel 2010 sürümü için destek rica ederim

 

[ordulu82]

Evdeki excel 2021 türkçe işyeri ise 2007 türkçe sürümü . dosyayı işyerinde kullanıcam.

 

[Korhan Ayhan]

Linkteki işlemi deneyebilirsiniz.

 

[ordulu82]

Linkteki işlemi deneyebilirsiniz.

Korhan Hocam makro ile yapmamız mümkün müdür? Çünkü veri birleştirme menüsünden yaptığımızda sadece 2 sütünü getiriyor aradaki sütunları boş bırakıyor. Yani kimlik numarasına göre sorgulama yapıyor son sütundaki çalışma saatlerini de kimlik numarasına göre toplayıp getiriyor. Fakat ortadaki ad, soyad vb. Hücreleri getirmiyor. Videodaki örnekte de zaten tüm hucreler toplama yapılacak hücreler olduğu için düzgün çalışıyor fakat benim dosyama uymuyor

 

[veyselemre]

Sub test()
    Dim sf As Worksheet, lR, dic, say, veri, i, ii, sira
    Set dic = CreateObject("Scripting.Dictionary")
    say = WorksheetFunction.CountA([OCAK!B4:B1000], [ŞUBAT!B4:B1000], _
                                   [MART!B4:B1000], [NİSAN!B4:B1000])
    ReDim tablo(1 To say, 1 To 6)
    say = 0
    For Each sf In Sheets(Array("OCAK", "ŞUBAT", "MART", "NİSAN"))
        With sf
            lR = .Cells(Rows.Count, 2).End(3).Row
            If lR > 3 Then
                veri = .Range("B4:G" & lR).Value
                For i = 1 To UBound(veri)
                    If dic.exists(veri(i, 1)) Then
                        sira = dic.Item(veri(i, 1))
                        tablo(sira, 6) = tablo(sira, 6) + veri(i, 6)
                    Else
                        say = say + 1
                        For ii = 1 To 6
                            tablo(say, ii) = veri(i, ii)
                        Next ii
                        dic.Item(veri(i, 1)) = say
                    End If
                Next i
            End If
        End With
    Next
    With Sheets("TOPLAM")
        Sheets("OCAK").Range("B3:G3").Copy .Range("B3:G3")
        .Range("B4:G" & Rows.Count).ClearContents
        .Range("B4:G4").Resize(say).Value = tablo
    End With
End Sub

 

[Korhan Ayhan]

Kullandığınız ofis sürümü bilgisini linki inceleyerek profilinizde güncellemenizi rica ederim.

Bilgi - Profillerde yazan "Ofis Sürümü ve Dili" bilgisi hakkında

Merhaba Değerli Forum Üyeleri, Belki dikkatinizi çekmiştir. Son zamanlarda birçok üyemize açtıkları başlıklarda cevap vermeden önce "Kullandığınız ofis sürümü ve dili nedir?" şeklinde mesaj yazıyorum. Bu alanın kullanım amacı sizlere verilecek cevaplar için önem arz etmektedir. Bu sebeple bu...

www.excel.web.tr

 

[ordulu82]

Sub test()
    Dim sf As Worksheet, lR, dic, say, veri, i, ii, sira
    Set dic = CreateObject("Scripting.Dictionary")
    say = WorksheetFunction.CountA([OCAK!B4:B1000], [ŞUBAT!B4:B1000], _
                                   [MART!B4:B1000], [NİSAN!B4:B1000])
    ReDim tablo(1 To say, 1 To 6)
    say = 0
    For Each sf In Sheets(Array("OCAK", "ŞUBAT", "MART", "NİSAN"))
        With sf
            lR = .Cells(Rows.Count, 2).End(3).Row
            If lR > 3 Then
                veri = .Range("B4:G" & lR).Value
                For i = 1 To UBound(veri)
                    If dic.exists(veri(i, 1)) Then
                        sira = dic.Item(veri(i, 1))
                        tablo(sira, 6) = tablo(sira, 6) + veri(i, 6)
                    Else
                        say = say + 1
                        For ii = 1 To 6
                            tablo(say, ii) = veri(i, ii)
                        Next ii
                        dic.Item(veri(i, 1)) = say
                    End If
                Next i
            End If
        End With
    Next
    With Sheets("TOPLAM")
        Sheets("OCAK").Range("B3:G3").Copy .Range("B3:G3")
        .Range("B4:G" & Rows.Count).ClearContents
        .Range("B4:G4").Resize(say).Value = tablo
    End With
End Sub

Sub test()
    Dim sf As Worksheet, lR, dic, say, veri, i, ii, sira
    Set dic = CreateObject("Scripting.Dictionary")
    say = WorksheetFunction.CountA([OCAK!B4:B1000], [ŞUBAT!B4:B1000], _
                                   [MART!B4:B1000], [NİSAN!B4:B1000])
    ReDim tablo(1 To say, 1 To 6)
    say = 0
    For Each sf In Sheets(Array("OCAK", "ŞUBAT", "MART", "NİSAN"))
        With sf
            lR = .Cells(Rows.Count, 2).End(3).Row
            If lR > 3 Then
                veri = .Range("B4:G" & lR).Value
                For i = 1 To UBound(veri)
                    If dic.exists(veri(i, 1)) Then
                        sira = dic.Item(veri(i, 1))
                        tablo(sira, 6) = tablo(sira, 6) + veri(i, 6)
                    Else
                        say = say + 1
                        For ii = 1 To 6
                            tablo(say, ii) = veri(i, ii)
                        Next ii
                        dic.Item(veri(i, 1)) = say
                    End If
                Next i
            End If
        End With
    Next
    With Sheets("TOPLAM")
        Sheets("OCAK").Range("B3:G3").Copy .Range("B3:G3")
        .Range("B4:G" & Rows.Count).ClearContents
        .Range("B4:G4").Resize(say).Value = tablo
    End With
End Sub

Öncelikle çok teşekkür ederim kod oldukça sağlıklı çalışıyor. Fakat açıklamada belirttiğim gibi dosyada ocak ile aralık ayları arasındaki tüm aylar mevcut kod sanırım ocak-nisan ayları arası için hazırlanmış yeni bir ay eklediğimde hata mesajı alıyorum. Eğer kodun düzenlenmesi mümkün olursa cok sevinirim. şimdiden yardımlarınız için teşekkür ederim.

 

[Korhan Ayhan]

Kullandığınız ofis sürümü bilgisini linki inceleyerek profilinizde güncellemenizi rica ederim.

Bilgi - Profillerde yazan "Ofis Sürümü ve Dili" bilgisi hakkında

Merhaba Değerli Forum Üyeleri, Belki dikkatinizi çekmiştir. Son zamanlarda birçok üyemize açtıkları başlıklarda cevap vermeden önce "Kullandığınız ofis sürümü ve dili nedir?" şeklinde mesaj yazıyorum. Bu alanın kullanım amacı sizlere verilecek cevaplar için önem arz etmektedir. Bu sebeple bu...

www.excel.web.tr