Birleşmiş Hücrelerde Otomatik Numaralandırma

[Filose]

Merhaba arkadaşlar,

Birleştirilmiş dolu hücrelere otomatik sıra numarası vermek istiyorum. Buradan aldığım bilgilerle bunu tek hücreler için yaptım ve çok yavaş çalıştı. İşime yaramadı beceremedim. Kısaca;

D11 Hücresi doluysa B11 Hücresine 1 yazsın. Aşağıya doğru numaralayarak devam etsin. BOŞ SATIRA NUMARA YOK. SADECE DOLU SATIRLARA VE NUMARA ATLAMAYACAK

Ekte dosyamda ayrıntılı görülmektedir.

Bütün arkadaşlara saygılar sunarım.

 

[Ömer BARAN]

Merhaba.

-- Formül ile; B11 hücresine aşağıdaki formülü uygulayın ve aşağı doğru liste boyunca kopyalayın.
.

=EĞER(D11<>"";MAK($B$10:B10)+1;"")

-- Kod ile (seçenek 1);

Sub SIRA_NO()
    With Range("B11:B91")
        .Formula = "=IF(D11<>"""",MAX($B$10:B10)+1,"""")": .Value = .Value
    End With
End Sub

-- Kod ile (seçenek 2,3: Sadece kırmızı veya mavi satırı kullanın, diğerini silin);

Sub SIRA_NO2()
For brn = 11 To 91 Step 2
    If Cells(brn, 4) <> "" Then Cells(brn, 2) = _
        [COLOR="Red"]WorksheetFunction.Max(Range(Cells(10, 2), Cells(brn - 2, 2))) + 1[/COLOR]
        [COLOR="Blue"]WorksheetFunction.CountA(Range(Cells(9, 4), Cells(brn - 2, 4))) + 1[/COLOR]
Next
End Sub

 

[Filose]

Ömer bey Merhaba,

ilginiz için teşekkür ederim. Modüle ekleyerek buton ile çalışmadı. Sayfanın kod bölümünde de çalışmadı.

Kullanacağım dosyada sayfanın kod bölümünde başka bir KOD var. Onun başına yazdım çalışmadı. Acaba sayfanın birden fazla kodu varsa buna engel olur mu?

Saygılar sunarım.

 

[Ömer BARAN]

Dosyanız ekte.

Sayfanın kod bölümüne uyguladım, sorun olmaması gerekir.
İLAVE NOT: Eğer Worksheet_Change kod'u kullanıyorsanız, o kodu gözden geçirmekte yarar var.
Sorun devam ederse, mevcut kodların da içinde bulunduğu örnek belge eklerseniz bakayım.

Burada sorun yok ama, hücre birleştirmelerinden kaçınmanızı öneririm.

Hücre birleştirmeleri;
-- formül oluştururken formüllerin gereksiz uzamasına,
-- kod oluştururken de bazı başka sıkıntılara neden oluyor zaman zaman.
.

 

[Filose]

Tekrar Merhaba Ömer bey,

son yazdığınız kod da çalışmadı. Özür dilerim buton ile çalıştı.
Butonsuz (yani otomatik) olabilirmi?

Yanlız, Kullandığım dosyada sayfa'ya başka bir kod yazılmış ikisi de çalışır mı acaba.

Tekrar ellerinize sağlık diyorum.

 

[Ömer BARAN]

Sayfayı yenileyip bir önceki cevabıma tekrar göz atın isterseniz.
Örnek dosyada sorun yok.

 

[Ömer BARAN]

İşte bu nedenle, örnek belgelerin, gerçek belge ile aynı yapıda olmasını rica etmekteyiz.

Ekteki belgede Vergi Dairesi sütununda değişiklik olduğunda numaralandırma otomatik çalışıyor.
Söylediğim gibi aynı sayfada başka Worksheet_Change kod'u olmaması gerekir.
Varsa, iki kod'un, birlekte değerlendirilip gözden geçirilerek düzenlenmesi gerekecektir.

 

[Filose]

Ömer Bey Merhaba,

Önce verdiğiniz değerli bilgiler ve öneriler nedeniyle size çok teşekkür ediyorum.

Dediğiniz gibi aynı sayfada Worksheet_Change var. Bu yüzden çalışmadı.
Ama tek başına sorun yok. Bu değerli bilgileriniz zaten işime tam yaradı.
Çok faydalı oldunuz elleriniz dert görmesin.

İyi çalışmalar
Saygılarımla,

 

[Filose]

Ömer Bey Merhaba,

Yazdığınız kodu buton ile çalışıyor sorun yok. Ancak dediğiniz gibi aynı sayfa için Worksheet_Change kodu var. Bende sizin hazırladığınız kodu en başa yazdım ama hata veriyor ve iki kod arasındaki uyumluluğu sağlayamadım.

Kısaca bilginize ihtiyacım doğdu. Dosyayı ekte gönderdim. Bakabilirseniz çok memnun olurum. Teşekkür eder saygılar sunarım.

 

[Ömer BARAN]

Bu belgeyi hatırlıyorum biraz.
BS5 hücresiyle ilgili kısım, BS5 hücresine elle işlem yapıldığından ona ilişkin kısım otomatik çalışır.
Peki D1191 aralığındaki veriler elle mi yazılıyor yoksa formül filan mı kullanıyorsunuz?

Ya da sıra numarası verme işlemini de BS5 hücresine bağlayıp,
BS5 hücresinde değişiklik olduğunda numaralandırma işleminin yapılması kolaylıkla olur sanırım.

Eğer bu şekilde sorun yoksa;
-- üstteki Worksheet_Change kodunu silin,
-- Alttaki Worksheet_Change koduna End Sub satırından önce Call SIRA_NO2 şeklinde bir satır ekleyin.
-- SIRA_NO2 kod'undaki kırmızı kısımları değiştirin,

Range("B11:C[B][COLOR="red"]89[/COLOR][/B]").ClearContents
For brn = 11 To [B][COLOR="red"]89[/COLOR][/B]

 

[Filose]

Merhaba Ömer Bey,

Bu dosyanın bu kısmını sizin emeğinizle oldu zaten. Aslında bu sayfaya bağlı bir çok sayfa daha var. Buralardan veriler alınıyor.

Tam dediğiniz gibi BS5 hücresine 1-12 arasında değer giriliyor Kırmızı renkli alanlar ona göre işaretleniyor.

O zaman sıra numarası verme işlemini de BS5 hücresine bağlayıp, BS5 hücresinde değişiklik olduğunda numaralandırma işleminin yapılması dediğiniz gibi çok güzel olur.

D11:AL91 aralığı elle veri giriliyor.

Bilginize ve emeğinize sağlık diyorum...

 

[Ömer BARAN]

D sütununda verileri elle yazdığınıza göre, aşağıdaki şekilde olur.

-- Üstteki Worksheet_Change kod'unu silin.
-- SIRA_NO2 ve alttaki Worksheet_Change kodunu da aşağıdaki ile değiştirin.

.

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [BS5,D11:D91]) Is Nothing Then Exit Sub
[COLOR="Red"]    If Target.Column = 4 Then Call SIRA_NO2[/COLOR]
[COLOR="Blue"]    If Target.Column = 4 And Target.Row > 10 And Target.Row < 91 Then Call SIRA_NO2[/COLOR]
        If Target.Address(0, 0) = "BS5" Then Call işlem
[B]End Sub[/B]

[B]Sub SIRA_NO2()[/B]
Range("B11:C90").ClearContents
For brn = 11 To 89 Step 2
    If Cells(brn, 4) <> "" Then Cells(brn, 2) = _
       WorksheetFunction.Max(Range(Cells(10, 2), Cells(brn - 2, 2))) + 1
Next
[B]End Sub[/B]

 

[Filose]

Ömer Bey hiç bir sorun yok. Kod çalışıyor.
Her şey için teşekkür ederim.
Bilginize, Ellerinize sağlık.

 

[Ömer BARAN]

Kolay gelsin, iyi günler dilerim.

 

[Ömer BARAN]

Bir ilave not; gönderdiğim, kod içeren cevapta değişiklik yaptım.

-- Kırmızı renklendirdiğim kod satırını silip,
-- onun yerine mavi renklendirdiğim kod satırını kullanmanız daha doğru olur.

Önceki kod cevabımı, sayfayı yenileyerek tekrar kontrol edin.

Tekrar iyi günler dilerim.
.

 

[Filose]

Çok teşekkür ederim Ömer bey. Dediğiniz satır kodunu da değiştirdim. Hiçbir sorun yok çalışıyor.

Tekrar saygılar sunar ellerinizi sağlık.
Hoşça kalın.

 

[Ömer BARAN]

Çok teşekkür ederim Ömer bey. Dediğiniz satır kodunu da değiştirdim. Hiçbir sorun yok çalışıyor.

Tekrar saygılar sunar ellerinizi sağlık.
Hoşça kalın.

Tekrar merhaba.

Son yazdığım mesajdaki -kırmızı satırı silip yerine mavi satırı ekleme ile ilgili-
düzeltmenin pek anlamının olmadığını fark ettim zaten kod'un aktifleşeceği alan
If Intersect(Target, [BS5,D1191]) Is Nothing Then Exit Sub
olduğuna göre önceki cevabımdaki kırmızı hali de yeterli oluyor.

İyi günler, kolay gelsin.
Trabzon'a selam olsun.
.

 

[Filose]

Merhaba Ömer Bey,

Dediğinizi anladım ve uyguladım. Tekrar çok teşekkür eder, saygı ve sevgiyle kalın. Ayrıca Trabzon için de Aleyküm Selam diyorum.

İyi çalışmalar dilerim.