Tarihlere Göre Hücre oluşturma

[Crieus]

Merhabalar sayın forum kullanıcıları, bir sorunum var kısaca anlatayım.
Excel sayfasında günlere ait kayıtlar var ve her tarihin bitimine birleştirilmiş bir hücre actırıp suyun olarak bulunan verileri saydırıp bir metin yazdırmam gerekli . Örneğin yanlızca 3 adet evrak vardır. Şeklinde yazmak istiyorum
Excel dosyasını ek yapamıyorum fakat görselini ekliyorum.

 

[Crieus]

Görsel Ektedir.

 

[ÖmerFaruk]

" her tarihin bitimine birleştirilmiş bir hücre actırıp "
Bunun da görselini atarmısın

 

[Crieus]

Hocam excellde 3 farkı tarih var. Farklı tarihlerin altına yapacak işlemi. Birazdan örnek atıyorum

 

[Crieus]

" her tarihin bitimine birleştirilmiş bir hücre actırıp "
Bunun da görselini atarmısın

İstenilen örn
Ekledim hocam

 

[ÖmerFaruk]

Sayfanın Kod bölümünde çalıştırın

Sub SatırEkle()
    i = 4 'ilk satır numaranız, yanlışsa doğrusuyla değiştirin
    Do
        say = WorksheetFunction.CountIf(Range("C:C"), Range("C" & i))
        Rows(i + say).Insert
        'Belirmediğiniz için A-H sütunlarını birleştirdim
        'Farklıysa harfleri değiştirin
        'Ayrıca hücre formatını belirtirseniz o da ayarlanabilir.
        Range("A" & i + say, "H" & i + say).Merge
        Range("A" & i + say) = "YALNIZCA " & say & " ADET EVRAK KAYDEDİLMİŞTİR ."
        Range("A" & i + say).HorizontalAlignment = xlCenter
        i = i + say + 1
    Loop Until Not IsDate(Range("C" & i))
End Sub

 

[Crieus]

Teşekkürler hocam sağolun

 

[Crieus]

Sayfanın Kod bölümünde çalıştırın

Sub SatırEkle()
    i = 4 'ilk satır numaranız, yanlışsa doğrusuyla değiştirin
    Do
        say = WorksheetFunction.CountIf(Range("C:C"), Range("C" & i))
        Rows(i + say).Insert
        'Belirmediğiniz için A-H sütunlarını birleştirdim
        'Farklıysa harfleri değiştirin
        'Ayrıca hücre formatını belirtirseniz o da ayarlanabilir.
        Range("A" & i + say, "H" & i + say).Merge
        Range("A" & i + say) = "YALNIZCA " & say & " ADET EVRAK KAYDEDİLMİŞTİR ."
        Range("A" & i + say).HorizontalAlignment = xlCenter
        i = i + say + 1
    Loop Until Not IsDate(Range("C" & i))
End Sub

Hocam bu kodları çalıştırdım fakat buton veya worksheet yaptığımda ilk açtığı kaydı açmaya devam ediyor. Ve alttaraflara kayıt açmıyor. Exceli tekrar temizleyip yeniden makroyu kullanmam gerekiyor.
Bunu kodlardan çözemedim.
Çözebilir miyiz. Yoksa bu kodları tek tıkla silinecek ve sonra tekrar butonla çalışacak hali ilede yapabilir miyiz.
Yani bu işleme silme mi koysak bilemedim

 

[ÖmerFaruk]

Range("A" & i + say, "H" & i + say).Merge
Range("A" & i + say) = "YALNIZCA " & say & " ADET EVRAK KAYDEDİLMİŞTİR ."

işleminden dolayı, ilkinin peşine kodları tekrar çalıştırırsanız dediğiniz durum olmak zorunda.

Kodların başında gerekli kontrol ve silme işlemlerini ekledim.. Örnek dosyanız olmadığı için kontrol edemedim. Deneyin lütfen.

Sub SatırEkle()
    For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
        If InStr(1, Range("A1"), "YALNIZCA ") > 0 Then Rows(i).Delete
    Next i
    i = 4 'ilk satır numaranız, yanlışsa doğrusuyla değiştirin
    Do
        say = WorksheetFunction.CountIf(Range("C:C"), Range("C" & i))
        Rows(i + say).Insert
        'Belirmediğiniz için A-H sütunlarını birleştirdim
        'Farklıysa harfleri değiştirin
        'Ayrıca hücre formatını belirtirseniz o da ayarlanabilir.
        Range("A" & i + say, "H" & i + say).Merge
        Range("A" & i + say) = "YALNIZCA " & say & " ADET EVRAK KAYDEDİLMİŞTİR ."
        Range("A" & i + say).HorizontalAlignment = xlCenter
        i = i + say + 1
    Loop Until Not IsDate(Range("C" & i))
End Sub

 

[Crieus]

Range("A" & i + say, "H" & i + say).Merge
Range("A" & i + say) = "YALNIZCA " & say & " ADET EVRAK KAYDEDİLMİŞTİR ."

işleminden dolayı, ilkinin peşine kodları tekrar çalıştırırsanız dediğiniz durum olmak zorunda.

Kodların başında gerekli kontrol ve silme işlemlerini ekledim.. Örnek dosyanız olmadığı için kontrol edemedim. Deneyin lütfen.

Sub SatırEkle()
    For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
        If InStr(1, Range("A1"), "YALNIZCA ") > 0 Then Rows(i).Delete
    Next i
    i = 4 'ilk satır numaranız, yanlışsa doğrusuyla değiştirin
    Do
        say = WorksheetFunction.CountIf(Range("C:C"), Range("C" & i))
        Rows(i + say).Insert
        'Belirmediğiniz için A-H sütunlarını birleştirdim
        'Farklıysa harfleri değiştirin
        'Ayrıca hücre formatını belirtirseniz o da ayarlanabilir.
        Range("A" & i + say, "H" & i + say).Merge
        Range("A" & i + say) = "YALNIZCA " & say & " ADET EVRAK KAYDEDİLMİŞTİR ."
        Range("A" & i + say).HorizontalAlignment = xlCenter
        i = i + say + 1
    Loop Until Not IsDate(Range("C" & i))
End Sub

Denedim hocam ama aynı şekilde çalışıyor.
Üst üste kullanınca macroyu ilk yazdığının altına devam ediyor.

 

[ÖmerFaruk]

If InStr(1, Range("A" & i ), "YALNIZCA ") > 0 Then Rows(i).Delete
bu satırı yeni haliyle değiştirir misin

 

[Crieus]

If InStr(1, Range("A" & i ), "YALNIZCA ") > 0 Then Rows(i).Delete
bu satırı yeni haliyle değiştirir misin

Hocam harikasın