Döngü Hk.

[leo57]

Merhabalar Arkadaşlar,
Sorum belki başlık ile alakasız olabilir şimdiden kusura bakmayın konu sonuca ulaşınca uygun başlığı veririz
Sorum şu;

A Sütunu ile H Sütunu arasında soldan sağa doğru bir döngü kurarak en son dolu hücreyi bulup o hücreyi kopyalamak ve K Sütununa yani bir yan hücreye yazdırmak istiyorum fakat bir türlü nasıl yapacağımı bulamadım.
Yardımlarınızı rica ediyorum.

 

[Mustafa MUTLU]

Denermisiniz :

Sub Bul()
For xx = 1 To 8
If Cells(1, xx) = "" Then
Cells(1, "k") = Cells(1, xx - 1)
Exit Sub
End If
Next
End Sub

 

[leo57]

Mrb Mustafa Bey,
Kodu deniyorum fakat hiç bir tepki vermiyor
Örnek olarak şöyle anlatayım.
A Sütunu ile H sütunu arasında soldan sağa doğru veriler var.
Verilerin kimi Soldan sağa doğru C Sütununa kadardır.
Verilerin kimi Soldan sağa doğru E Sütununa kadardır.
Sabit değil yani

Ben soldan sağa doğru en son dolu hücredeki veriyi kopyalayıp K Sütununda ilgili hücrelere yapıştırmak istiyorum.
Örnek eklemeyi bilmediğim için bu şekilde anlatayım dedim. Umarım anlaşılır olmuştur.

Dikey döngünün yatayı gibi birşey istediğim.
Syg.

 

[Mustafa MUTLU]

A sütunu daima son satıra kadar dolu varsayarak ?..
Bu Kodu denermisiniz..

Sub Bul()
For zz = 1 To Cells(65536, "A").End(xlUp).Row
For xx = 1 To 8
If Cells(zz, xx) = "" Then
Cells(zz, "k") = Cells(zz, xx - 1)
GoTo Gel
End If
Next
Gel:
Next
End Sub

 

[leo57]

Tekrar Mrb Mustafa Bey,

A Sütunu ile H Sütunu arasında tam dolu olanlarda son hücredeki veriyi almıyor.
Fakat A Sütunu ile H Sütunu arasında tam dolu olmayanların son hücredeki veriyi K Sütununa alıyor.

Yani atıyorum A Sütunundan G Sütununa kadar veri var. G Sütundaki soldan sağa doğru son hücredeki veriyi alıyor.

Fakat A Sütunu ile H Sütunu arası eksiksiz dolu ise H Sünunda soldan sağa doğru son hücredeki veriyi almıyor
Syg.

İsterseniz bir mail adresi vermeniz mümkün ise (sakıncası yok ise ) size mail de atabilirim buraya eklemeyi yapamıyorum.

Sizi uğraştırıyorum kusura bakmayın.

 

[leo57]

Tekrar mrb.

If Cells(zz, xx) = "" Then

Bu satırdan kaynaklanıyor olabilir mi acaba ?
Syg.

 

[Mustafa MUTLU]

I sütunu boş ise

For xx = 1 To 8
Burasını
For xx = 1 To 9
Olarak değiştiriniz.

Bu durumda I sütunu tüm satırlarda boş olmalıdır.

 

[Necdet]

Bir basit dosya sorunun çoktan çözülmesini sağlardı.

 

[leo57]

Mustafa Bey ,
Dediğiniz gibi yaptım ve harika oldu çok teşekkür ederim ellerinize sağlık.

@Necdet Üstadım,
Dosya eklemeyi bilmediğim için yapamadım ama en kısa zamanda öğrenicem
Hayırlı Geceler.
Syg.

 

[Mustafa MUTLU]

Mustafa Bey ,
Dediğiniz gibi yaptım ve harika oldu çok teşekkür ederim ellerinize sağlık.

@Necdet Üstadım,
Dosya eklemeyi bilmediğim için yapamadım ama en kısa zamanda öğrenicem
Hayırlı Geceler.
Syg.

İşini Gördü ise ne mutlu
İyi Geceler...

 

[Necdet]

Ben soruyu şöyle anladım.

A1:G1 alanındaki son dolu hücreyi K1,
A2:G2 alanındaki son dolu hücreyi K2 gibi

Eğer durum bu ise benim kodlarım şöyle olacaktır :

Sub Makro1()
 
    Dim i As Long
 
    For i = 1 To Range("A:H").Find("*", , , , xlByRows, xlPrevious).Row
        Cells(i, "I").End(xlToLeft).Copy Cells(i, "K")
    Next i
 
End Sub

Yani 1. satırdan başlayacak A:G sütunlarındaki son satıra kadar döngü çalışacak ve her satırdaki son hücreyi K sütununa yazacak.

Not : Linki İnceleyiniz TIKLA

 

[Korhan Ayhan]

Bende bir alternatif kod önerebilirim.

Sub AKTAR()
    Dim Son As Long, X As Long
    
    Son = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Columns(11).ClearContents
    
    For X = 1 To Son
        Cells(X, 11) = Evaluate("=LOOKUP(2,1/(A" & X & ":H" & X & "<>""""),A" & X & ":H" & X & ")")
        If IsError(Cells(X, 11)) Then Cells(X, 11) = ""
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub