Forwat tipi mailleri düzelten macro

[KANAS]

üstadlar aklıma bir gün bir soru geldi yarısını yaptım bi kısmında takıldım araştırma yaparken bu sitede çakılı kaldım. Şöyle malum sık sık hepimize forwart edilen mailler gelir bazen bozuk karakterler içeriri dil kodlamasından ötürü bazen de forwart o kadar çokdur ki işte "spacelerle" vaya ">" karakterleri ile doludur.
Bir macro yapayım dedim içine attığım metni otomatik düzeltsin.
Nesini yaptım türkçe karakter içermiyen harfleri türkçeleştirdi mesela bende "ı" boyle gözüken karakter "ı" harfine değiştirdi ">" bunu sildi birde çift boşlukları sildi. (büyük "Ş" ile büyük "Ğ" kodları ilerde gelirse ekliycem çünkü onlar düzgündü bilmiyorum bu yüzden ) Herşey tamam fakat bazı boş satırları silemedim sebebi içinde bir tane space karakteri olduğu için boş görmediğinden olmuyor. Örnek metni ve yaptığım macroyu ekliyorum. Metni boş sayfaya atın bu macro ile çalıştırın eksikleri göreceksiniz.
Çok önemli değil tabiki bu macro da, maksat öğrenmek merakımızı gidermek boş vakti olan cevaplasın teşekkürler...

 

[Levent Menteşoğlu]

Bu istediğinizi mevcut kod yapınızla yapmak zor bir döngü kurmak gerekir. Bunun içinde metnin kopyalandığı sütunun alt ve üst sınırını döngüde tanımlamak gerekir. Ekli dosyayı inceleyin. Kodlarınıza gerekli ilave yapılmıştır.

 

[KANAS]

Teşekkürler "leventm" programcılık bilmediğimiz için tabiki yeni bir şeyler üretemiyoruz (Allahtan kayıt macro var) ancak olanlar üstünde değişiklik yapabiliyoruz. Ben ufak bir ilave daha yapdım fazladan boşluklar hiç kalmadı.
Ama satır başlarında tek boşlukla başlayan metinlere nasıl bir kod yazabiliriz ? Sadece Boşlukla başlayan satırların başdaki boşluklarını silsin.
Şimdiden Teşekkürler ne biliyim insan mutlu oluyor bişeler ortaya çıkınca yoksa hakketen boşuna uğraştırıyorum sizi :icelim:
Değişiklik yaptığım macroyu yolluyorum...

 

[Levent Menteşoğlu]

Döngünün içine aşağıdaki mavi renkli satırı ekleyerek deneyin.

For a = [a65536].End(3).Row To 1 Step -1
If Len(Replace(Cells(a, "a"), " ", "")) = 0 Then Rows(a).Delete
[COLOR=blue][B]Cells(a, "a") = LTrim(Cells(a, "a"))[/B][/COLOR]
Next

 

[Kemal Demir]

Sub Soldanboşluk()
'Kaçinci Kolon
z = 1
For x = 1 To 10000
yeniden:
If left(Cells(x, z), 1) = " " Then
Cells(x, z) = Left(Cells(x, z), Len(Cells(x, z)) - 1)
GoTo yeniden
End If
Next
End Sub

Yukarıdaki Kod:Soldan Kaç Boşluk varsa Boşlukları silmenizde İşinize yarayabilir.

 

[cqners]

Güzel bir konu,

Epeyi işime yarayacak. Bilgiler için herkese Teşekkür ederim.

 

[KANAS]

Aynen herkese ayrı ayrı teşekkür ediyorum, çalışmanın son halini ekliyorum. Bari işe yarasın exel dosyamız 2 sayfadır biri maillerden gelen bozuk karakterli yazıları kopyala yapıştır yaptıktan sonra metin düzelt düğmesi tıklanarak son halini alır 2. sayfada örnek bir metin var denemeniz için, bu bana forwatlı bir mail ile gelmişti yazının kaynağını bilmiyorum ama Depremden korunmayıda anlatıyor... :hey: