Eğer Bul Değiştir Makrosu

[meleklerim]

Arkadaşlar Merhaba

Bir hücredeki veriler

@Ad;Soyad@Ad;Soyad@Ad;Soyad@Ad;Soyad
düzenine göre girilmiş
Fakat bazı satırlardaki verilerde sadece @Ad var, Soyad yok
@Ad@Ad;Soyad@Ad;Soyad@Ad;Soyad
@Ad;Soyad@Ad;Soyad@Ad;Soyad@Ad
@Ad;Soyad@Ad@Ad;Soyad@Ad;Soyad
@Ad
Soyad olmayan verilerin @Ad;- şekline dönmesini istiyorum

Örnek
@a. hakan;tandoğan@ali can;yıldırım@hasan
ise
@hasan verisinin soyadı olmadığı için
@a. hakan;tandoğan@ali can;yıldırım@hasan;-

Satırlarda bu düzene uymayan verili düzeltebilecek makroya ihtiyacım var, şimdiden teşekkürler

ekli örnek dosya
http://dosya.co/lb916bk8yfa2/soyadekle.xlsx.html

 

[hamitcan]

En iyi çözüm Metni Sütunlara Dönüştür gibi görünüyor.

 

[meleklerim]

Malasef o yöntemle yapmak, gözle kontrol edip düzeltmek kadar uzun sürüyor.

Aslında bana
=Eğer(satırın sonundaki veri "@ad;soyad" şeklinde ise birşey yapma değilse "@ad;-" şekline getir demenin excelcesi lazım
bu kurala uymayan verilerin % 90 ı satırın en sonundaki veri. Onlar hallolsa aradakileri elle yaparım artık

 

[meleklerim]

Problem hale çözülemedi, yok mu bunu çözecek arkadaş?
Lütfen, veri sayısı çok olmasa elle yapardım.
Saygılarımla

 

[Ömer BARAN]

Merhaba.

Aşağıdaki iki durumda (satırın sonundaki kısım) elde edilmesi gereken sonuç nedir acaba, ayrı ayrı yazar mısınız?
Tam anlayamadım.
1) .....;-@Şehrazat
2) .....;-@Sabahat İzgü;
.

 

[meleklerim]

olan
1) .....;-@Şehrazat
2) .....;-@Sabahat İzgü;

olması gereken
1) .....;-@Şehrazat;-
2) .....;-@Sabahat İzgü;-

yani
veri @ ile başlıyor
içinde birbirinden ; ile ayrılmış 2 tür veri var (adı soyadı;karakteri)
kurala uymayanların 2. verileri yok. Olmayanlar için - kullanılmış.

2. formata uyan pek yok.
1. formatta çoğu. onların da hemen hemen hepsi satır sonunda.

yani satırdaki son verinin (@ ile başlıyor) içinde ; varsa dokunma yoksa sonuna ;- ekle denilse işim % 99 hallolur

 

[Ömer BARAN]

O zaman sadece sağdan ilk karakteri kontrol edip;
-- ; ise - ekle
-- değilse ;- ekle
işlemi mi yapılacak diyorsunuz?
İstediğiniz bu ise A1 hücresindeki veri için;
.

=EĞER(SAĞDAN(A1;1)=";";A1&"-";A1&";-")

 

[meleklerim]

ama kurala uyan hücrenin de sonunda ; yok.
sıkıntı orada...

@veri1 şeklinde olanların sonuna ;- getirilirip @veri1;- olması gerekiyor.
@veri1;veri2 olanlara birşey yapmayacak

 

[Ömer BARAN]

Sanırım aradaki verilere de çözüm arıyorsunuz.
Ben de Sayın hamitcan gibi düşünüyorum; en iyi yöntem metni sütunlara dönüştürme.

Metni sütunlara dönüştürüp, bir adet de formül ekleyerek nihai çözüme ulaşılabilir diye düşünüyorum.

Hazırladığım (gerçi siz bir örnek belge bile eklemediniz ama üşenmeyip ben hazırladım) belgeye
buradan ulaşabilirsiniz.
.

 

[meleklerim]

hepsinde aynı sayıda veri yok. bazı verilerde 300 veri var, bazılarında 1. sonra bunları tekrar birleştirmede sorun çıkacağını sanıyorum.
belge hazırlamak mesele değil, konunun girişine eklemiştim.
Belgenin orjinalini ekte

http://s3.dosya.tc/server8/tcji4x/DATA_kisi.rar.html

ilgilendiğiniz için teşekkürler

 

[Ömer BARAN]

Merhaba.

Verileri boş bir belgenin A sütununa (2'nci satırdan saşlayarak) aktarın.
Alt taraftan, verileri yapıştırdığınız sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin açılan ekranın sağ tarafına aşağıdaki kod'u yapıştırın ve çalıştırın.
Sonuçlar B sütununa yazılır. Sonuçları kontrol ediniz.
Daha kısa da olur gibi geliyor ama biraz bunaldım ve madem sonuca varılıyor o zaman yeterli dedim.
.

[FONT="Arial Narrow"]Sub DÜZELTME_BRN()
Columns("B:B").ClearContents: On Error Resume Next
For sat = 2 To [A65536].End(3).Row
        ek = 1: et = 1
    For brn = 1 To Len(Cells(sat, 1))
        If Len(Cells(sat, 1)) - Len(Replace(Cells(sat, 1), "@", "")) = 1 Then
            yer = WorksheetFunction.Find("@", Cells(sat, 1), 1)
            sonunda = Mid(Cells(sat, 1), 2, Len(Cells(sat, 1)) - 1)
            sonuç = sonunda & ";-"
            GoTo 30
        End If
cc = StrReverse(Cells(sat, 1))
sonparça = StrReverse(Mid(cc, 1, WorksheetFunction.Find("@", cc, 1) - 1))
    If brn >= Len(Cells(sat, 1)) Then GoTo 10
        aaa = Mid(Cells(sat, 1), brn - etadet, Len(Cells(sat, 1)) - et + 1)
        If aaa = sonparça Then
            metin = sonparça
            GoTo 10
        End If
et = WorksheetFunction.Find("@", aaa, brn - etadet)
parça = Mid(Cells(sat, 1), brn - etadet, et - 1)
        If Len(parça) <> Len(Replace(parça, ";", "")) Then
            metin = parça
        Else
            ilave = ilave & ";-": metin = parça & ilave
        End If
ek = Len(parça) + 1: brn = brn + ek: etadet = etadet + 1
10: sonuç = sonuç & metin & "@"
    If metin = sonparça Then GoTo 20
    Next
20: sonuç = Mid(sonuç, 1, Len(sonuç) - 1)
    If Mid(sonuç, 1, 1) = ";" Then
        sonuç = Mid(sonuç, 4, Len(sonuç) - 2)
    End If
30: Cells(sat, 2) = sonuç
    sonuç = "": metin = "": parça = "": etadet = 0: ilave = "": aaa = "": sonparça = ""
Next: MsgBox "BİTTİ"
End Sub[/FONT]

 

[meleklerim]

çok teşekkürler Ömer Bey, sizi de yordum kusura bakmayın.
Bu akşam dener sizi bilgilendiririm. tekrar tekrar teşekkürler