Soru A Sutununda Bulunan Boşluğa Göre Kopyalama

[tefon]

Arkadaşlar merhaba,
Elimde bulunan bir dosyada boşluklar ve dosya isimleri mevcut. A sutunundaki boşluğa göre dosya isimlerini alt satıra kopyalamak istiyorum.

Örnek Dosya;

Resim1	Resim2	Resim3	Resim4	Resim5	Resim6
1.jpg	1.jpg		2.jpg
2.jpg		1.jpg			3.jpg
3.jpg			1.jpg	1.jpg
4.jpg	5.jpg				1.jpg
5.jpg

Olmasını istediğim;

Resim1	Resim2	Resim3	Resim4	Resim5	Resim6
1.jpg	1.jpg		2.jpg
1.jpg	1.jpg		2.jpg
1.jpg	1.jpg		2.jpg
2.jpg		1.jpg			3.jpg
2.jpg		1.jpg			3.jpg
2.jpg		1.jpg			3.jpg
2.jpg		1.jpg			3.jpg
2.jpg		1.jpg			3.jpg
3.jpg			1.jpg	1.jpg
3.jpg			1.jpg	1.jpg
3.jpg			1.jpg	1.jpg
3.jpg			1.jpg	1.jpg
3.jpg			1.jpg	1.jpg
4.jpg	5.jpg				1.jpg
4.jpg	5.jpg				1.jpg
4.jpg	5.jpg				1.jpg
4.jpg	5.jpg				1.jpg
4.jpg	5.jpg				1.jpg
5.jpg

Bu konu ile ilgili çözüm ne olabilir?
Teşekkür ediyorum.

 

[TiOr]

Selam,

Örnek A sütununu komple seçin F5 basın gelen ekranda özele tıklayın ikinci gelen ekranda boşlukları tikleyin ve tamam deyin.
Sonrasında = eşittire tıklayarak ctrl basılı tutun ve sol ok tuşuna basın ve enterlayın.

Dosyanız ektedir...

İyi çalışmalar.

 

[TiOr]

Selam,

Örnek A sütununu komple seçin F5 basın gelen ekranda özele tıklayın ikinci gelen ekranda boşlukları tikleyin ve tamam deyin.
Sonrasında = eşittire tıklayarak ctrl basılı tutun ve basılı iken sol ok üst ok tuşuna basın ve enterlayın.

Dosyanız ektedir...

İyi çalışmalar.

Düzeltmedir.

 

[tefon]

Düzeltmedir.

B - C - D - E ve F sutunlarını doldurmadı. Boşlukları seçtikten sonra (eşittir =) tıklama olarak tam olarak ne yapmam gerekiyor anlamadım.

 

[TiOr]

Videoyu; İzleyiniz...

Not; Tüm sütunlara bu işlemi ayrı ayrı yapmanız gerekmektedir.

Makro ile uygulamak ister iseniz;
Aşağıdaki kodu deneyiniz makro ile olan dosyayı ekte paylaşıyorum.

Sub Makro1()

    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("C:C").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("D:D").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("E:E").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("F:F").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Range("A1").Select
   
End Sub

 

[tefon]

İstediğim şey bu değil aslında. Örnek olarak eklediğim satır-sütunları incelemenizi rica edeceğim. Teşekkür ederim.

 

[TiOr]

Anlatımınızdan anlaşılan bu olduğu için bu şekilde paylaşım yapılmıştır.
Başarılar...

 

[alicimri]

Veriler Sayfa1 de olduğunu varsayarsak Sayfa2 de B2 hücresine, aşağıdaki formülü yapıştırıp, sağa ve aşağıya doğru çoğaltın.

=EĞER(Sayfa1!B2<>"";Sayfa1!B2;EĞER($A2="";B1;""))

 

[alicimri]

Veriler Sayfa1 de olduğunu varsayarsak makrolu çözüm

Sub doldur()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
satir = s1.Cells(Cells.Rows.Count, "A").End(3).Row
sutun = s1.Cells(1, s1.Cells.Columns.Count).End(xlToLeft).Column
For i = 2 To satir
For e = 2 To sutun
If Cells(i, "A") = "" And Cells(i, e).Offset(-1, 0) <> "" Then
Cells(i, e).Value = Cells(i, e).Offset(-1, 0)
End If
Next
Next
For x = 2 To satir
If s1.Range("A" & x) = "" Then
s1.Range("A" & x).Value = s1.Range("A" & x).Offset(-1, 0)
End If
Next
End Sub

 

[alicimri]

Makro ile formül yapıştırılarak yapılan çözüm.

Sub doldur1()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
satir = s1.Cells(Cells.Rows.Count, "A").End(3).Row
sutun = s1.Cells(1, s1.Cells.Columns.Count).End(xlToLeft).Column
s1.Range(s1.Cells(2, 2), s1.Cells(satir, sutun)).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=IF(AND(RC1="""",R[-1]C<>""""),R[-1]C,"""")"
End Sub