Soru Hücredeki sayıları renklerini değiştirmeden sayıları sıralama nasıl yapabilirim

[Zeyback]

Merhaba,


A2 başlayıp A hücresinin son dolu satırını seçip arasını sıralamak istiyorum. Fakat hücrelerde bulunan renklerin değişmemesi gerekmektedir.

Örnek dosyam

https://www.sendspace.com/file/scfohl


Yardımlarınız için teşekkürler

 

[Korhan Ayhan]

Merhaba,

İlk satıra filtre uyguladım. Sonrasında A1 hücresinde ki filtre menüsüne tıklayıp ilk seçenek olan A-Z sırala komutunu çalıştırdım.

Sizde aynısını yaparak çözüme gidebilirsiniz.

 

[Zeyback]

Merhaba Korhan bey,

Sanırım yanlış anlattım. Renge göre sıralatmayı zaten yapıyorum makro ile fakat numaralarda doğal olarak renge göre değişiyor. Benim istediğim renge göre yapıldıktan sonra tekrar 1 den başlayıp son satıra kadar yeniden numaralandırmak

Teşekkürler

 

[Korhan Ayhan]

Benim mesajımda renkle ilgili bir ifade var mı?

Sizin paylaştığınız dosyada A sütununda zaten sıra no var. Ben bu sütuna göre sıralama yapmak istediğinizi anladığım için bu şekilde cevap verdim. Bu sıralama işleminde renklerde hücrelerle hareket ettiği için sizin istediğini sonucu vereceğini düşündüm.

Belki ben talebinizi yanlış anlamış olabilirim.

 

[netzone]

Merhaba @Zeyback,
Siz sıralama yapsın fakat renkler aynı kalsın istiyorsunuz, Her zaman ilk Başlık+5 satır renklenecek ise:
A:D sütun aralığını seçin ve koşul eklemeyi şu şekilde düzenleyin.
iyi çalışmalar.

 

[Zeyback]

Merhaba Netzone,

Bu listeye ek ve yeni numaralar sürekli eklenmektedir.
renkler sıralandıktan sonra, başında bulunan numaralar en yukarıdan başlayıp sıralı olarak 1,2,3.... gibi alt alta eyniden numaralandırılması gerekmektedir. Bunu yaptığımda o anda a hücresinde bulunan renkte değişmemesi gerekiyor. Öernek olarak gönderdiğim dosyada yeşilin son 2 satırının numarası 15 olduğunu görebilirsiniz a sütunu yeniden numaralandırma istiyorum makro ile orada bir sıralama yaptığımda a hücresindeki renkler bozulmaktadır. bunu çözmek istiyorum..
Teşekkürler

 

[netzone]

@Zeyback, O zaman şu şekilde yapabilirsiniz. (*Sıralamayı yaptırdıktan sonra)
A2 ye 1 yazın, A3 e 2 yazın, seçip hücre kulpuna çift tıklayın biçimlendirmeyi yok sayıp son satıra kadar artan şekilde sıra numarası vermiş olacaktır.
iyi çalışmalar.

Makro Kaydet ile elde ettiğim kodlar

Sub Makro1()
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("A2:A3").Select
    Selection.AutoFill Destination:=Range("A2:A18"), Type:=xlFillValues
End Sub

 

[Zeyback]

Netzone,
Selection.AutoFill Destination:=Range("A2:A18"), Type:=xlFillValues
hemen hemen oldu gibi bir eksik var, dediğim gibi sürekli ek bilgi eklenmektedir. A18 kalmamaktadır. yeni numaralara eklenmektedir. Burada son A hücresini nasıl belirtebiliriz.
Yardımlarınız için teşekküler

 

[Korhan Ayhan]

A2 hücresine aşağıdaki formülü uygularsanız sonuca gidebilirsiniz.

=EĞER(B2="";"";SATIR(A1))

 

[Zeyback]

Merhaba Korhan bey,



Sub Makro1()

' NO SIRALAMA
sds = Sheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "2"
Range("A2:A3").Select
Selection.AutoFill Destination:=Range("A2:A" & sds), Type:=xlFillValues

End Sub

kodda A sütünunda A2 hücresi ve devamındaki A hücreleri ilk açılışta boş ise hata veriyor

Run-time error '1004':
Range sınıfının Autofill yöntemi başarısız

şeklinde, yardımlarınızı bekliyorum.

Teşekkürler

 

[Korhan Ayhan]

Son dolu hücre kontrolünü sıra no sütununa göre yapmak çok sağlıklı olmayabilir.

Bence "B" sütununu kullanın.

sds = Sheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row

 

[Korhan Ayhan]

Ya da direk aşağıdaki kodu deneyebilirsiniz.

Option Explicit

Sub Sira_No()
    Dim S1 As Worksheet
    
    Set S1 = Sheets("Sayfa1")
        
    If WorksheetFunction.CountA(S1.Range("B2:B" & S1.Rows.Count)) > 0 Then
        With S1.Range("A2")
            .Resize(S1.Rows.Count - 1).ClearContents
            .Value = 1
            .AutoFill Destination:=.Resize(S1.Cells(S1.Rows.Count, "B").End(3).Row - 1), Type:=xlFillSeries
        End With
    End If

    Set S1 = Nothing
End Sub

 

[Zeyback]

Merhaba,

https://www.sendspace.com/file/asteng
son verdiğiniz Kodu iki dosya üzerinde de denedim, boş olan üzerinde herhangi bir işlem yapmadan devam ediyor burada bir sıkıntı yok. Dolu dosyada numaralandırma yaparken ilk hücre sarı diğer hücrelerin rengi yeşil olması gerektiği halde onları da sarı yapıp numara vermektedir.

Teşekkürler

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sira_No()
    Dim S1 As Worksheet
    
    Set S1 = Sheets("Sayfa1")
        
    S1.Range("A2:A" & S1.Rows.Count).ClearContents
        
    If WorksheetFunction.CountA(S1.Range("B2:B" & S1.Rows.Count)) > 0 Then
        With S1.Range("A2:A" & S1.Cells(S1.Rows.Count, "B").End(3).Row)
            .Formula = "=ROW(A1)"
            .Value = .Value
        End With
    End If

    Set S1 = Nothing
End Sub

 

[Zeyback]

Korhan bey,

Allah razı olsun tam istediğim gibi oldu. Teşekkürler