Bir sütundaki verileri satırlara bölüp sıralama

[cengiz123]

Merhabalar
A sütununda bazı verilerim var. A1, A2, A3.. ..A50ye kadar veriler sıralı.
Meyveler
erik
elma
muz
Sıra5
Karpuz
Meyveler
Armut
Sıra7
Üzüm
Kavun
Meyveler
Mandalina
Sıra3
Portakal
..
..

Bu yukarıdaki sıralama da Meyveler gruplandırılmış durumda.
Makro ile şunu yapmak için ustalardan destek rica ediyorum.
Tek sütundan satır satır aşağıdaki gibi gruplandırabilir miyiz
A1 ;Meyveler Sıra Erik Elma muz karpuz
A2 ;Meyveler Sıra armut üzüm kavun
A3 ;Meyveler Sıra mandalina portakal

Sıra kelimesi(sıra5,7,3) herzaman meyvelerden sonra gelecektir.

Biraz uzun oldu ancak umarım doğru anlatmışımdır.
Özetle;
2 Meyveler kelimesi arası gruplanacak ve sıra ile başlayan kelime(sıra5,sıra7,sıra3) meyveler kelimesinden sonrasına yerleştirilecek.
Yardımlarınız için şimdiden çok teşekkürler

 

[Ömer BARAN]

Merhaba.

Verilerin A1 hücresinden başlayarak A sütununda olduğu varsayılmıştır.
A sütunundaki verileri silmek yerine;
işlem sonuçlarının B1'den başlayarak B sütununa yazılmasının daha güvenli olduğunu ve işlem sonucunun kontrolü imkanını vereceğini düşündüm.

Aşağıdaki kod istediğiniz sonucu üretecektir.
.

[B]Sub MEYVELER()[/B]
If MsgBox("İşlem sonuçları B sütununa yazılacak." & vbLf & _
        "Bu nedenle; önce B sütununda mevcut veriler silinecek!.." & _
        vbLf & vbLf & "İşlemi onaylıyor musunuz ?", _
        vbCritical + vbYesNo, "Dikkat: SİLME ONAYI") = vbYes Then
    [B:B].ClearContents
    For sat = 1 To Cells(Rows.Count, 1).End(3).Row
        If Cells(sat, 1) = "Meyveler" Then
            yeni = Cells(Rows.Count, 2).End(3).Row + 1
            If Cells(1, 2) = "" Then yeni = 1
            sat = sat + 1
            For satt = sat To Cells(Rows.Count, 1).End(3).Row
                If Cells(satt, 1) = "Meyveler" Then GoTo 10
                If Left(Cells(satt, 1), 4) = "Sıra" Then
                    metin = "Sıra " & metin
                Else: metin = metin & " " & Cells(satt, 1)
                End If
            Next
        End If
10:     sat = satt - 1: Cells(yeni, 2) = "Meyveler " & metin: metin = ""
    Next: MsgBox "İşlem tamamlanmıştır.", vbInformation, "..::.. Ömer BARAN ..::.."
Else: MsgBox "İşlem iptal edilmiştir.", vbInformation, "..::.. Ömer BARAN ..::.."
End If
[B]End Sub[/B]

 

[cengiz123]

Ömer bey çok teşekkür edrim.
Çok güzel olmuş. Ancak sıra kelimesi hep ikinci sırada olması lazım. Onu nasıl düzenleyebiliriz.

 

[Ömer BARAN]

Verdiğim kod istenileni yapıyor olmalıdır.
Sorun yaşıyorsanız, verdiğim kod'un uygulandığı ve hatalı işlem yaptığı haliyle bir örnek belge hazırlayarak ekleyip, hataları açılayınız.

Örnek belge özellikleri ve örnek belge yükleme yöntemine ilişkin açıklama cevabımın altındaki İMZA bölümünde var.
.

 

[cengiz123]

Merhaba Ömer bey,
Sıra yerime sıra yazdım.

Çok çok teşekkür ederim

 

[cengiz123]

Merhaba Ömer bey,
Kod çok güzel çalışıyor. Ancak sıra kelimesinin içinde bulunan 3,5,7 rakamlarını taşımıyor. Sadece sıra yazıyor sıra3,sıra5,sıra7 şeklinde değil
yardımcı olur musunuz size zahmet