Sıra no boş satıra geldiğinde vermesin

[Mdemir63]

Selamlar,
Arkadaşlar, ekteki dosyamda kalanlar makrosunu çalıştırdığımda işlemi yapıyor, ancak son dolu satırdan sonra sıra no vermeye devam ediyor bunu nasıl engelleyebilirim?

Saygılar

 

[Mdemir63]

Selamlar,

Arkadaşlar ekteki dosyamla ilgilenebilmeniz mümkünmüdür?

Saygılar

 

[Ferhat Pazarçevirdi]

Merhabalar

kalanlar makronuz çalışsa da bir şey yapmaz. Çünkü oluşturduğunuz döngü sadece tekrar yapıyor ve boşa çalışıyor...

Ne yapmak istediğinizi açıklarsanız, kodlarınız istediğiniz şekilde revize edilebilir.

Dim b
Sheets("kalanlar").Select
Range("A2:G5000").ClearContents
b = 1
x = 0
For Each secim In Worksheets("ANA LİSTE").Range("G3:G1500")
[COLOR=green]'G sütunda 1500 satirlik veri taranmaya başlanıyor[/COLOR]
    If secim = "" Then
  [COLOR=green]     'Eğer seçilen hücrenin değeri boşsa, -ki başta temizlik yapıldığı için hep boş olacak.[/COLOR]
       x = x + 1
       Worksheets("kalanlar").Cells(b, 1) = x
[COLOR=green]       'A1 hücresine, hesaplanan x değerini yaz. b değişkeninin değeri değişmediği sürece de hep A1'e yazmaya devam edecek. [/COLOR]
       Worksheets("kalanlar").Cells(b, 2) = secim.Offset(0, -5)
[COLOR=green]       'b değeri yine 1 ve hep B2 hücresine, G sütunun ilgili hücresinin beş sütun olsunun değeri eşitleniyor.[/COLOR]
       Worksheets("kalanlar").Cells(b, 3) = secim.Offset(0, -4)
       Worksheets("kalanlar").Cells(b, 4) = secim.Offset(0, -3)
       Worksheets("kalanlar").Cells(b, 5) = secim.Offset(0, -2)
       Worksheets("kalanlar").Cells(b, 6) = secim.Offset(0, -1)
       Worksheets("kalanlar").Cells(b, 7) = secim.Offset(0, 0)
End If
Next
MsgBox ("GELECEKLER LİSTESİ YAPILDI")

 

[Mdemir63]

Hocam merhabalar,

Yeni dosyamı gönderdim ona bakabilirmisiniz?
Bu dosyada Gelenler butonuna bastığımızda E ve K olanları aktarıyor.
Kalanlar butonuna bastığımızda da boş olanları kalanları aktarıyor buraya kadar bir problem yok problem aktardığı bilgilerin dışında boş olan satırlar için de sıra numarası veriyor G3:G1500 aralığını verilerin olduğu kadar yapabilir çözebilirim ancak daha sonra Ana listeye yeni bilgi eklediğimde tekrar bu aralığı düzenlemem gekekir .Bunlara gerek kalmadan son bilgileri aktardıktan sonra en son bilgiye sıra no verdikten sonra boş yerler için sıra numarası vermesin istiyorum. Sadece sıkıntı burası

Saygılar sunarım

 

[AS3434]

Sayın komutan63

Kalanlar makrosunu şöyle değiştirin.

Sub Kalanlar()
Dim b
Sheets("Kalanlar").Select 'Gelenler Sayfasını seç
Range("A2:G2000").ClearContents
b = 1
x = 0
For Each secim In Worksheets("ANA LİSTE").Range("G3:G1000")
If secim = "" Then 'Sadece boş olanları aktarır
    b = b + 1
 [COLOR=green]   'x = x + 1[/COLOR]
[COLOR=green]    'Worksheets("Kalanlar").Cells(b, 1) = x[/COLOR]
    Worksheets("Kalanlar").Cells(b, 2) = secim.Offset(0, -5)
    Worksheets("Kalanlar").Cells(b, 3) = secim.Offset(0, -4)
    Worksheets("Kalanlar").Cells(b, 4) = secim.Offset(0, -3)
    Worksheets("Kalanlar").Cells(b, 5) = secim.Offset(0, -2)
    Worksheets("Kalanlar").Cells(b, 6) = secim.Offset(0, -1)
    Worksheets("Kalanlar").Cells(b, 7) = secim.Offset(0, 1)
End If
Next
[COLOR=blue]For i = 2 To [b65536].End(3).Row[/COLOR]
[COLOR=blue]If Not Cells(i, 2) = "" Then[/COLOR]
[COLOR=blue]sırano = sırano + 1[/COLOR]
[COLOR=blue]Cells(i, 1) = sırano[/COLOR]
[COLOR=blue]End If[/COLOR]
[COLOR=blue]Next i[/COLOR]
MsgBox ("KALANLAR LİSTESİ YAPILDI")
End Sub

Bu kodlarla sıra nosu veren satır iptal edilip (yeşil kısım), yeni bir döngü kullanılmıştır. (mavi Kısım)



.

 

[Mdemir63]

Hocam çok teşekkürler

Saygılar