Soru Excel'de farklı müşteri isimleri arası ve dahil olduğu tüm sütunlara otomatik boşluk ekleme

[Mag Queen]

1. Örnek liste ekran görüntüsü
2. Örnek liste ekran görüntüsü

Merhaba, ne kadar uğraşsam da kolay yöntem bulamadığım bir problem var. Sorun şu ki

Farklı müşteri isimlerinin yazılı olduğu ve ekran görüntüsündeki 1. örnek listede görüldüğü üzere kişi isimleri tekrar edebiliyor.
Bu listede, her seferinde farklı müşteri isimlerinin arasına dahil olduğu tüm sütunları dahil ederek tek tek satır seçerek boşluk bırakmayı ayarlıyorum. Çoğu zaman 100 kişiden fazla isim olabiliyor listede. O vakit tek tek seçerek boşluğu ayarlamak zahmetli ve zaman kaybı oluyor.

2. Ekran görüntüsünde görüldüğü gibi olmasını istiyorum.

Bunu kolayca halledebileceğim bir yol, formülü veya makro kodu varsa yardımcı olur musunuz?

 

[alicimri]

Deneyin

Sub ekle()
For i = Cells(Rows.Count, 1).End(3).Row - 1 To 3 Step -1
If Cells(i, 1) <> Cells(i - 1, 1) Then
  Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End Sub

 

[yanginci34]

Aşağıdaki kodu bir modüle yapıştırıp dener misiniz.
Sub bosluk_ver()
Dim son
Dim i
son = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
For i = 3 To son
son = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If Cells(i, 1) <> "" And Cells(i - 1, 1) <> "" And Cells(i, 1) <> Cells(i - 1, 1) Then
Cells(i, 1).Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 1).Select
End If
Next
End Sub

 

[Mag Queen]

Aşağıdaki kodu bir modüle yapıştırıp dener misiniz.
Sub bosluk_ver()
Dim son
Dim i
son = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
For i = 3 To son
son = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If Cells(i, 1) <> "" And Cells(i - 1, 1) <> "" And Cells(i, 1) <> Cells(i - 1, 1) Then
Cells(i, 1).Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 1).Select
End If
Next
End Sub

söylediğiniz kodu yapıştırdım fakat hata verdi. ekran görüntüsünü ekliyorum.

ekran görüntüsü
2. görüntü

 

[Mag Queen]

Deneyin

Sub ekle()
For i = Cells(Rows.Count, 1).End(3).Row - 1 To 3 Step -1
If Cells(i, 1) <> Cells(i - 1, 1) Then
  Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End Sub

sizin vermiş olduğunuz kod ise çalışıyor fakat örnek liste üzerinde çalıştı diğer asıl listede çalışmadı. sebebi nedir neden işe yaramadı anlamadım.

 

[alicimri]

örnek liste ile asıl liste arasında ne fark var.

 

[Mag Queen]

örnek liste ile asıl liste arasında ne fark var.

bir fark yok aslında, sadece daha fazla müşteri ismi var.

Birkaç deneme yaptıktan sonra sorunun kaynağı sanırım şu, excel dosyası bana apple bilgisayardan hazırlanıp atılıyordu bu nedenle excel sayfasının ismi sol alttaki yer sayfa1 yazması gerekirken Worksheet yazılıymış. sanırım bu nedenle de marko işe yaramıyor, hata vermiyor sadece boş çalışıyor işe yaramaz halde yani. bende listenin tamamını seçip kopyalayarak boş bir excel dosyasına listeyi yapıştırdım ve modüle kodu yapıştırdım ve ayrıca sayfa2 yazan yerleri sayfa1 diye düzelttim anca bu şekilde işe yaradı.
acaba bu worksheet yazan veya diğer bir ifadeyle apple dan gelen excel i (whatsaptan indiriyorum bu arada dosyayı) uğraşmadan kodu nasıl işe yarar hale getirebilirim?

 

[alicimri]

Yanginci34 arkadaşın kodunu da denedim çalışıyor, Sheets("Sayfa2"). kısmını silin.
apple dan gelen excel de ne sorun var, bilemiyorum. O dosyayı tcdosya gibi bir dosya paylaşım sitesine eklersen bir baklım.

 

[yanginci34]

Benim yazmış olduğum kodu kendinize uyarlamanız gerekir örnek dosya eklemediğiniz için ben kendim kafama göre uyarladım.
Örneğin benim sayfamın ismi Sayfa2 siz kodun içindeki sayfa isimlerini uyarlayın ve tablonun başlangıcı olan fatura adı A sütununda mı? Aşağıda kırmızı yerleri kendinize göre uyarlayın.
Sub bosluk_ver()
Dim son
Dim i
son = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
For i = 3 To son
son = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If Cells(i, 1) <> "" And Cells(i - 1, 1) <> "" And Cells(i, 1) <> Cells(i - 1, 1) Then
Cells(i, 1).Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 1).Select
End If
Next
End Sub