Tek hücrede 2 koşula göre 2-3 sonucu alt alta yazdırma

[karadami]

Merhabalar,

Hazırlamaya çalıştığım raporun bir yerinde sorun yaşıyorum ve maalesef kendi başıma bu işin altından kalkamadım.

Günlük olarak 10-15 satır olarak girilen verilerden 1 sayfada o günün tarihine göre yaşanan sıkıntıları tek 1 hücrede alt alta yazdırılması gerekiyor. Örnek dosyanın linki aşağıdadır. Yardımlarınız için şimdiden teşekkür ederim.


http://s3.dosya.tc/server13/sx1mdv/GENEL_RAPOR.xlsx.html

 

[Ömer BARAN]

Merhaba.

Konuyu FONKSİYONLAR bölümüne açmışsınız ancak VBA ile çözüm önerisinde bulunayım.

-- Alt taraftan GENEL RAPOR sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılacak olan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın,
-- GENEL RAPOR sayfasına şekil/metin kutusu gibi bir nesne ekleyin,
-- Eklediğiniz bu nesneye fareyle sağ tıklayıp MAKRO ATA'yı seçin,
-- Açılacak küçük ekranda, HATALAR isimli makronun adını seçerek işlemi onaylayın,
Artık bu nesneye fareyle tıkladığınızda kod istenilen sonucu üretecektir.

Kod'un çalışma mantığı:
-- İsmi "GENEL RAPOR", "ŞİKAYET" ve "gönderilen" olmayan sayfaların
H sütunundaki değer 0'dan büyük olan satırları için;
-- A sütunundaki tarihi GENEL RAPOR sayfası A sütununa yazar,
-- GENEL RAPOR sayfası O sütununa 1 ekler,
-- GENEL RAPOR sayfası P sütununa ise istediğiniz gibi metin birleştirmesini yapar.
.

[B]Sub [COLOR="Red"]HATALAR[/COLOR]()[/B]
Set g = Sheets("GENEL RAPOR")
son = g.Cells.SpecialCells(xlCellTypeLastCell).Row
If son > 3 Then
    g.Range("A4:A" & son).ClearContents
    g.Range("O4:P" & son).ClearContents
End If

For Each shf In ThisWorkbook.Sheets
    If shf.Name <> "[B][COLOR="Blue"]GENEL RAPOR[/COLOR][/B]" And shf.Name <> "[B][COLOR="blue"]gönderilen[/COLOR][/B]" And shf.Name <> "[B][COLOR="blue"]ŞİKAYET[/COLOR][/B]" Then
        For ssat = 2 To shf.Cells(Rows.Count, 1).End(3).Row
            If shf.Cells(ssat, "H") > 0 Then
                If WorksheetFunction.CountIf(g.[A:A], shf.Cells(ssat, 1)) = 0 Then
                    gsat = g.Cells(Rows.Count, 1).End(3).Row + 1
                    g.Cells(gsat, 1) = shf.Cells(ssat, 1)
                Else
                    gsat = WorksheetFunction.Match(shf.Cells(ssat, 1), g.[A:A], 0)
                End If
                    g.Cells(gsat, "O") = g.Cells(gsat, "O") + 1
                    g.Cells(gsat, "P") = g.Cells(gsat, "P") & Chr(10) & shf.Cells(ssat, "I")
                        If Mid(g.Cells(gsat, "P"), 1, 1) = Chr(10) Then _
                            g.Cells(gsat, "P") = Mid(g.Cells(gsat, "P"), 2, 255)
            End If
        Next
    End If
Next
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]

 

[karadami]

Sayın Ömer BARAN,

Cevabınız için teşekkür ederim. Birkaç düzenleme ile işimi göreceğini düşünüyorum. Ellerinize sağlık...