Otomatik Doldurma Makrosu

[conkz]

Benim 2 sütun verim var. Örnekteki gibi. Aradaki tüm boşlukları otomatik doldurmak istiyorum. Sürükleyerek veya çift tıklayarak yaptığımda çok fazla vakit kaybı oluyor. Çünkü normalde dosyamda 700'e yakın öğrenci 7000'e yakın veri oluyor. Her yapışımda 700 kere tutup aşağı çekmek tam bir eziyet. Bunu makroyla yapabilmemin bir yolu var mı? Tam olarak anlatamadıysam Örnek Dosyasının makroyla Örnek 2 dosyasındaki haline gelmesini istiyorum.

Makroyla veya makrosuz bunu yapmanın kısa yolunu bulabilirsek çok memnun olacağım.

 

[Necdet]

Merhaba,

Lütfen arama yapınız.


Boş Hücreleri Kendinden Önceki Dolu Hücre İle Doldurmak

 

[usubaykan]

Merhaba;

Necdet bey link vermiş ama ben sorunun içinde olduğum için göremedim. Artık aşağıdaki kod alternatif oldu. Önce Necdet beyin tavsiyesine uyun bencede kendinizin uygulayacağı kod daha yararlı olacaktır.

Option Explicit
Sub deneme()
Dim u As Long, s As Long
'A sütunu için
 
    For u = 2 To Range("B65536").End(3).Row
        If Cells(u, "A") = "" Then
        Cells(u, "A") = Cells(u - 1, "A")
        End If
    Next
'B sütunu için
    For s = 2 To Range("B65536").End(3).Row
        If Cells(s, "B") = "" Then
        Cells(s, "B") = Cells(s - 1, "B")
        End If
    Next
  MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "Sn: " & Application.UserName
 
End Sub

 

[conkz]

Teşekkür ederim. Genelde arama yapmadan sormam zaten soru ama bugün yoğunluktan 10 dk molada anca sorabildim. Ondan arama yapmaya falan fırsatım olmadı. Hallettim sorunu makroya falan da gerek yok böyle olduğu sürece. Tekrardan teşekkürler.

Düzeltme: Yazarken görmemişim pardon. usubaykan size de teşekkürler, en kısa sürede kodu da deneyeceğim.

 

[nsertoglu]

İstenen (A ve B) kolonlarda dolu olan değerin tekrarı

Aşağıdaki MAKRO ile işleminiz yapılabilecektir:

Sub Sutun_doldur()

sayf = "sayfa1"
k_bas = 1 ' başlangıç kolon no
k_bit = 2 ' bitiş kolon no

r_bas = 2 ' başlangıç satır no
r_bit = 47 ' bitiş satır no

For k = k_bas To k_bit
For r = r_bas To r_bit
Cells(r, k).Select
If Cells(r, k) <> Empty Then
deger = Cells(r, k)
r = r + 1
While Cells(r, k) <> deger And Cells(r, k) = Empty
If Cells(r, k) = Empty And deger <> Empty Then
If r <= r_bit Then
Cells(r, k).Select
Cells(r, k) = deger
r = r + 1
Else
Exit For
End If
End If
Wend
r = r - 1
End If

Next r
Next k
End Sub