Makroyu Her Satıra uygulama

[aacanakova]

Arkadaşlar bir Excell listem var .

ilk sayfayı incelerseniz c5 te isim c6 da soyisim e5 te anne adı e 6 da baba adı var


şimdi benim istediğim şu ( ikinci sayfada ki )
c5-6-7 hücreyi birleştirerek tek hücre yapmak ve ismi oraya yazmak
d5-6-7 hücreyi birleştirerek tek hücre yapmak ve soyismi oraya yazmak
e5-6-7 hücreyi birleştirerek tek hücre yapmak ve anneadını oraya yazmak
f5-6-7 hücreyi birleştirerek tek hücre yapmak ve anneadını oraya yazmak

bunu makroyla yaptım basit olarak ama sadece manuel yaptığım bu üç satırda oldu aşağıya doğru 1000 tane daha aynı veriden düşünün
her satırda otomatik olarak nasıl yaptırabilirim bunu ,ve bu sayfa gibi 500 küsür daha sayfa var .

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Her sayfa için kodu bir kez çalıştırın. İkinci kez çalıştırırsanız veri kaybına uğrayabilirsiniz.

Option Explicit
 
Sub TABLOYU_DÜZENLE()
    Dim SAYFA As Worksheet
    Dim ADI As String, SOYADI As String
    Dim ANNE_ADI As String, BABA_ADI As String
    Dim X As Long
 
    For Each SAYFA In Worksheets
 
        With SAYFA
 
        For X = 5 To .Range("A65536").End(3).Row + 2 Step 3
            ADI = .Cells(X, "C")
            SOYADI = .Cells(X + 1, "C")
            ANNE_ADI = .Cells(X, "E")
            BABA_ADI = .Cells(X + 1, "E")
 
                With .Range(.Cells(X, "C"), .Cells(X + 2, "C"))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .Value = Empty
                    .MergeCells = True
                    .Value = ADI
                End With
 
                With .Range(.Cells(X, "D"), .Cells(X + 2, "D"))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .Value = Empty
                    .MergeCells = True
                    .Value = SOYADI
                End With
 
                With .Range(.Cells(X, "E"), .Cells(X + 2, "E"))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .Value = Empty
                    .MergeCells = True
                    .Value = ANNE_ADI
                End With
 
                With .Range(.Cells(X, "F"), .Cells(X + 2, "F"))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .Value = Empty
                    .MergeCells = True
                    .Value = BABA_ADI
                End With
        Next
 
        End With
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[aacanakova]

Kod için çok teşekkür ederim ancak sadece adı ve anne adını almış soyadı ve baba adı kaybolmuş .Düzeltebilirmisiniz .

 

[Korhan Ayhan]

Selamlar,

Eklemiş olduğunuz örnek dosyanızda önerdiğim kodu denediğimde olumlu sonuç alıyorum. Sizde farklı yapıda veriler olabilir mi? Yada yanlışlıkla kodu birden fazla çalıştırmış olabilirsiniz.

 

[aacanakova]

Tekrar çok teşekkür ederim gönderdiğiniz kod gayet güzel çalışıyor sadece bende ki veride üstte bi satır fazla olduğundan çalışmadı


For X = 5 To Range("A65536").End(3).Row + 2 Step 3

For X = 6 yaptığım zaman düzeldi çok sağolun ilgilendiğiniz için

birde şunu sormak istiyorum

81 vilayeti açılan liste ile excell de görüyorum ama Mesela İstanbul u seçtiğim de istiyorum ki İstanbulun ilçeleri çıksın ,Antalya yı seçtiğimde Antalya nınkiler .Forumlarda vardır muhtemelen ama arattırmadım .Yardımcı olabilirseniz sevinirim .

 

[aacanakova]

Bir de unutmadan bu vermiş olduğunuz kodu tüm sayfalarda ayrı ayrı çalıştırmam mı gerekiyor .2 Çalışma kitabında toplam 552 tane sayfa var .Bunu bir seferde bir çalışma kitabına uygulayamazmıyım .

 

[Korhan Ayhan]

Selamlar,

Evet önerdiğim kodu her sayfa için tek tek çalıştırmalısınız. Ama tüm sayfaları içerecek şekilde düzenleyebiliriz. Buradaki önemli kriter bütün sayfalarınız aynı formatta olmasıdır.

 

[aacanakova]

Bütün sayfalardaki bilgiler satır sayısı hariç birebir aynı .Satır sayısı da önemli değil .

 

[Korhan Ayhan]

Selamlar,

#2 nolu mesajımdaki kodu güncelledim. Denermisiniz.

 

[aacanakova]

çok teşekkür ederim gayet güzel çalışıyor kodlar
birde şunu sormuştum ama ;

81 vilayeti açılan liste ile excell de görüyorum ama Mesela İstanbul u seçtiğim de istiyorum ki İstanbulun ilçeleri çıksın ,Antalya yı seçtiğimde Antalya nınkiler .Forumlarda vardır muhtemelen ama arattırmadım .Yardımcı olabilirseniz sevinirim .

 

[Korhan Ayhan]

Selamlar,

veri+doğrulama şeklinde arama yaparsanız örneklere ulaşabilirsiniz.