Bir Alt Satıra Göre Ardışık Sıralama

[oderkaya]

Selam arkadaşlar ,

Sorunun açıklamasını dosya içerisine yaptım.

Zaman ayıracak arkadaşlara şimdiden emekleri için teşekkürler ,

iyi çalışmalar,

 

[Ayhan Ercan]

Merhaba Sn oderkaya

Ek Dosyayı "SIRALA" düğmesini çalıştırarak inceleyiniz...

Private Sub CommandButton1_Click()
On Error Resume Next
Dim k As Range
For Each k In Range("a7:S7")
    k.Offset(-1, 0) = 1
    If k.Value = 0 And k.Offset(0, -1).Value = 0 Then k.Offset(-1, 0).Value = k.Offset(-1, -1).Value + 1
    If k.Value = 0 And k.Offset(0, -1).Value = 1 Then k.Offset(-1, 0).Value = k.Offset(-1, -1).Value + 1
    If k.Value = 1 And k.Offset(0, -1).Value = 0 Then k.Offset(-1, 0).Value = k.Offset(-1, -1).Value + 1
    If k.Value = 1 And k.Offset(0, -1).Value = 1 Then k.Offset(-1, 0).Value = k.Offset(-1, -1).Value
Next
End Sub

 

[oderkaya]

Teşekkürler sayın Ercan ,

ancak bu datalar örnekte a7 den S7 ye kadar. Gerçek hayatta A7 den S150 ye kadar vs. olabilir.
Ben " For Each k In Range("a7:S7") " değerini denemek için A7:S100 yaptığımda çok farklı çalıştı, işin ilginç tarafı eski haline getirip ("a7:S7") yaptığım halde de çalışmadı, tüm değerleri 1 olaak atadı ?

Bilg.

 

[oderkaya]

Soruyu Revİze Ettİm !

Açıklama dosyanın içerisinde ,

teşekkürler,

 

[oderkaya]

Ardışık Sıralama

Merhaba,

aslında macro ile çözümü olabilir ? diye düşündüğüm için bir de bu başlık altında sorayım dedim.
Soru dosyanın içindedir,

Çok Teşekkürler ,

 

[Orion1]

Dosyanız ekte.

Sub ardisik()
Dim no As Integer
no = 1
For i = 2 To 58
    Cells(5, i).Value = no
    If Cells(8, i + 1).Value = 1 Then no = no + 1
Next i
MsgBox "işlem tamamlandı"
End Sub

 

[oderkaya]

çok teşekkürler sayın Gizlen ,


For i = 2 To 100 yaparak işlem yapılacak 100 sütuna çıkardım, ancak eğer 65 lik bir data varsa bu sefer de son kayıt sonrası 100 e kadar her hücreye sürekli 65 yazıyor.

Çok önemli değil ancak bu işi 8. satırdaki hücrelerin dolu olup olmamasına bakarak yaparsa çok iyi olacak.Böylelikle işlemi 100 hücrede çalıştıracak,ancak 8. satırda hangi hücreye kadar dolu ise o kadar ardışık yazacak, sonrasını boş bırakacak.

emeğinize sağlık ,

 

[Orion1]

Aşağıdaki kodları kullanınız.

Sub ardisik()
Dim no As Integer
no = 1
For i = 2 To Cells(8, 256).End(xlToLeft).Column
    Cells(5, i).Value = no
    If Cells(8, i + 1).Value = 1 Then no = no + 1
Next i
MsgBox "işlem tamamlandı"
End Sub

 

[oderkaya]

Çok teşekkürler,

data elimde değil, ancak tam istediğim gibi çalışıyor görünüyor.

Yarın ilk iş deneyeceğim,

teşekkürler,

Macro yazımı başlangıcı için gerçekten açıklayıcı bir kaynak önerebilir misiniz, daha nereye kadar başkalarına böyle yük olup, hazır kodlar üzerinde mutasyon yoluyla iş çıkarmak veya copy/paste 'çılık )

çok çok teşekkürler ,

syg.

 

[Orion1]

Kaynak olarak sitede reklamı yapılan kitaplardan bir tanesini edinebilirsiniz.
Ve forumu takip ediniz.

 

[Ayhan Ercan]

Macro yazımı başlangıcı için gerçekten açıklayıcı bir kaynak önerebilir misiniz?

www.excel.web.tr

Öğrenmek için istemek yeterli...

İste!
Araştır!
Paylaş!

 

[oderkaya]

teşekkürler sayın Gizlen ,