Boşluk Bırakma

[akbayrakmahmut]

Excel sayfasında örneğin b sütununda alt alta 20 satır var bunlardan bazıları 3 bazıları 4 kelime olarak aynı aynı olan bu kelimelerin üst kısmına boşluk bırakıp gruplandırma istiyorun nasıl yaparım

Ocak
Ocak
Ocak
Şubat
Şubat
Mart
Mart
Mart
Mart

bunları bu şekilde yapmak istiyorum

ocak
Ocak
Ocak

şubat
Şubat

mart
Mart
Mart
Mart

 

[Ömer]

Merhaba,

Deneyiniz.

Sub test()
    Dim i As Long
    Application.ScreenUpdating = False
    For i = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
        If Cells(i, "A") <> Cells(i - 1, "A") Then
            Rows(i).Insert Shift:=xlDown
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[akbayrakmahmut]

Kod işe yaradı çok teşekkür ederim, bir sorum daha olacak

oluşan boşluklara bir alt ve soldaki hücreyi aktarabilir miyin satır sayısı değişebiliyor kelimelerde

		---------- oluşan boşluklar
Akito Sushi Bar	Beliebte Gerichte	Set 1	9,50€​
Akito Sushi Bar	Beliebte Gerichte	Love Salmon Platz (für 1 Person)	17,50€​
Akito Sushi Bar	Beliebte Gerichte	Tempura Futo (6 Stück)	10,00€​
		--------- oluşan boşluklar
Akito Sushi Bar	Sushi Sets	Set 1	9,50€​
Akito Sushi Bar	Sushi Sets	Set 2	10,50€​
Akito Sushi Bar	Sushi Sets	Set 3	14,50€​
		--------- oluşan boşluklar
Akito Sushi Bar	Vorspeisen	Yakitori (2 Stück)	4,20€​
Akito Sushi Bar	Vorspeisen	Ebi Tempura (3 Stück)	5,50€​
Akito Sushi Bar	Vorspeisen	Gyoza (5 Stück)	5,50€​
		--------- oluşan boşluklar
Akito Sushi Bar	Suppen	Miso Suppe	3,80€​
Akito Sushi Bar	Suppen	Miso Sake Suppe	4,50€​
Akito Sushi Bar	Suppen	Miso Ebi Suppe	4,50€​
Akito Sushi Bar	Salate	Edamame	4,50€​
Akito Sushi Bar	Salate	Salmon Seetang Salat	9,50€​
Akito Sushi Bar	Salate	Akito Sommer Salat	9,00€​

aslında iş bittiğinde formülü bu hale getirmek istiyorum ama sol alttaki kelimeyi boşluğa alabilirsem birleştir ile devam edebilirim diye düşünüyorum. İlginize teşekkürler

Filizs Kitchen & Catering	Preise
<h2>Beliebte Gerichte<h2>	#colspan#
Karniyarik	12,90€
Izmir Köfte	12,90€
Yesikfasulye	12,90€
<h2>Vorspeisen<h2>	#colspan#
Hummus (100g)	19,00€
Gebratene Karotten (100g)	19,00€
Gebratene Aubergine (100g)	19,00€
<h2>Spezialitäten des Hauses<h2>	#colspan#
Karniyarik	12,90€
Yesikfasulye	12,90€
Bamya	12,90€
<h2>Snacks<h2>	#colspan#
Sigara Börek mit Käse	1,30€
Börek mit Spinat und Käse	2,70€
Linsenköfte mit Salatblatt (5 Stück)	5,50€
<h2>Desserts<h2>	#colspan#
Schokoladenkuchen (1 Stück)	3,50€
Käsekuchen (1 Stück)	3,50€
Hausgemachter Milchkuchen (1 Stück)	3,50€
<h2>Alkoholfreie Getränke<h2>	#colspan#
Coca-Cola 0,5l (EINWEG)	5,35€
Coca-Cola Zero Sugar 0,5l (EINWEG)	5,35€
Fanta Orange 0,5l (EINWEG)	5,35€

 

[Ömer]

Merhaba,

İstediğiniz tam anlaşılmıyor. 10-15 satırlık örnek bir excel dosyayı ekleyip, eski verileri bir sayfaya olmasını istediğiniz son halini diğer sayfada oluşturup ekler misiniz.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

 

[akbayrakmahmut]

İndir Avrupa RESTORAN Kopya

Dosyayı indir Avrupa RESTORAN Kopya

dosya.co

Merhaba Sayfa1 de yer alan sarı alanları sizin paylaştığınız kod sayesinde boş bırakabildim sonuç olarak ikinci sayfayı elde etmek istiyorum. yani sarı alanın sol alt hücresinde yer alan verileri sarı alana aktardıktan sonra a ve b sütunlarını sileceğim.

Sonrasında ise sarı alana alana eklediğim kelimelerin önüne ve sonuna bitişik şekilde <h2> ekleyeceğim. sağdaki hücreye ise #colspan# yazmam gerekiyor. satır sayıları değiştiği için (hep üçlü denk gelmiyor) otomatik aktarımı yapmam gerekiyor.

 

[Ömer]

Bu işlemleri eski veri üzerinde aynı sayfada düzenleyecek değil mi? Düzenleme yeni bir sayfada olmayacak.

 

[akbayrakmahmut]

Evet aynı sayfada olacak ama yeni bir sayfada da olabilir çok önemli değil, sonrasında ilgili sayfayı yeni bir kitap olarak seçilen klasöre kaydedecim. toplam 600-700 sayfa var bu şekilde başka bir sayadan önce filitreleyip makro ile bu sayfaya aktarıyorum sonrasında kitap kitap kaydedeceğim

 

[Ömer]

Detaylı deneme yapmadım. Hata varsa nedeniyle birlikte detaylı açıklayınız.

Sub test()

    Dim i As Long, son As Long
    
    If Range("B2") = "#colspan#" Then Exit Sub
    son = Cells(Rows.Count, "B").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    If WorksheetFunction.CountBlank(Range("A1:B" & son)) > 0 Then
        Range("A1:B" & son).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        son = Cells(Rows.Count, "B").End(xlUp).Row
    End If
    
    Rows(1).Insert Shift:=xlDown
    
    Range("C1") = "Speisekarte"
    Range("D1") = "Preise"
    Range("C1:D1").Font.Bold = True
    
    For i = son To 2 Step -1
        If Cells(i, "B") <> Cells(i - 1, "B") Then
            Rows(i).Insert Shift:=xlDown
            Cells(i, "C") = "<h2>" & Cells(i + 1, "B") & "<h2>"
            Cells(i, "D") = "#colspan#"
            Cells(i, "C").Resize(1, 2).Font.Bold = True
        End If
    Next i
    
    Columns("A:B").Delete Shift:=xlToLeft
    Columns("A:B").EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
End Sub

 

[akbayrakmahmut]

Sistem tam istediğimiz gibi çalıştı emeğiniz için çok teşekkür ederim