Word'de Çoklu Bul-Değiştir

[Mertsan]

Word içinde çoklu kelime değiştirme

Selam dostlar;

Elimde 150 sayfa civarında "metin.doc" dosyası var.
Bütün boşlukları paragraf işaretiyle değiştirerek her kelimeyi tek paragraf haline getirdim.
Sonra bunları "kelimeler.xls" dosyası içerisine Sayfa1'in A sütununa yapıştırdım ve tekar eden kelimeleri çıkardım. Dolayısıyla hiçbir hücre içeriği tekrar etmiyor. Bu şekilde 2500 civarında kelime elde ettim.

Bunlardan değiştirmek istediğim epeyce kelime var. "kelimeler.xls" dosyası içinde B sütununa değiştirmek istediğim kelimeleri yazdım. Böylece değiştirmek istediğim 950 civarında kelime oluştu. Değişiklik yapmak istemediğim kelimeleri de listeden çıkarttım. Sonuçta A sütununda "metin.doc" içinde yer alan orijinal kelime, B sütununda da yaptığım değişiklik yer alıyor.

Sorum şu:

"metin.doc" dosyasına nasıl bir makro yazmalıyım ki, "kelimeler.xls" dosyasının A sütunundaki ilk kelimeyi içerikte bulsun ve bunu B sütununun ilk kelimesiyle değiştirsin.

Haluk Beyin oluşturduğu bir makro var çoklu değiştirmeyle ilgili. Belki bir fikir verir diye buraya ekliyorum.

Sub Hataduzelt_R()
    Dim Bul(), Duzelt()
    Bul = Array("ç", "ğ", "ı", "ö", "ş", "ü")
    Duzelt = Array("c", "g", "i", "o", "s", "u")
    Application.DisplayAlerts = False
    For i = 0 To 5
        With ActiveDocument.Content.Find
            .Text = Bul(i)
            .Replacement.Text = Duzelt(i)
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Application.DisplayAlerts = True
End Sub

Umarım derdimi anlatabilmişimdir.
Üstatların değerli yardımlarını bekliyorum efendim.

Merhabalar,

Excel'e girmeden direk Word içinde farklı farklı kelimeleri toplu olarak değiştirebileceğim bir kod ihtiyacı oluştu. Forumdaki aramalarımda yukarıdaki paylaşımda Sayın sinbade'nin paylaştığı kod ihtiyaca yakın bir örnek teşkil ediyor.

Kodu Word'te test ettiğimde çalıştığını gördüm. Kod Word içinde iki adet dizi kullanılmış, ilk dizideki harfler aynı sırayla ikinci dizideki Harfler ile yer değiştiriliyor. Harf yerine kelime değişikliği yapmak istiyorum. Basitçe harflerin yerine örnek olarak aşağıdaki kodda olduğu gibi değiştirmek istediğim kelimeleri yerleştirdiğimde işimi görüyor. Ancak onlar seviyesindeki kelime sayısında sorun olmasa da bu dizideki kelime sayısı yüz veya binler seviyesinde olduğunda değişimi tek tek diziye yazmak ve değiştirmek sorun olacak.

Yapmak istediğim Bul adlı değişkene atanan birinci diziyi ve Duzelt adlı değişkene atanan ikinci diziyi başka bir dış word dosyasından alıp işleyen bir kod. Yani dizilere atanacak kelimeleri bir dış dosyadan sayısı önemsenmeden alıp istediğimiz değişikliklerin olduğu ikinci dosyadakilerle değiştirilmesi.

Olanaklı ise şöyle bir çözüme de ihtiyacım var. Belki de bu çözüm daha öncelikli ve yeterli olacağı gibi çözümü de daha kolay olabilir. Tek bir kaynak dosyada çok sayıda kelime var. Kelimelerin arasına rastgele bir yere - (tire) işareti koyarak her kelimeyi ikiye bölecek.
Mesela kelimeyi elma=>el-ma veya elm-a gibi rastgele bir araya tire eklenmiş hale getirecek.

Yardımlarınız için şimdiden teşekkür ederim.

Sub Kelimeduzelt_R()
    Dim Bul(), Duzelt()
    Bul = Array("reno", "elma", "bulut", "yazilim", "bilim", "astro")
    Duzelt = Array("renolu", "elmacı", "bulutlu", "yazilimci", "bilimci", "astronomi")
    Application.DisplayAlerts = False
    For i = 0 To 5
        With ActiveDocument.Content.Find
            .Text = Bul(i)
            .Replacement.Text = Duzelt(i)
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Application.DisplayAlerts = True
End Sub

 

[Mertsan]

Değerli Arkadaşlar, bu konuda mevcut koda bir ekleme yapılabilir mi? Yardımcı olabilirseniz memnuniyet duyarım.
Mertt

 

[alicimri]

Sayın Mertsan
Asıl dosyanızın bulunduğu klasörde, b. doc adında word dosyası oluşturun.
b.doc dosyasında bir satır, iki sütunluk bir Tablo oluşturun
birinci sütuna değişecek kelimelerin arasına boşluk vermeden, satırbaşı başı yapmadan sadece virgül koyarak yazın ama sonuna da yine virgül ve fazladan kelime daha ekleyin* (Bul için)
reno,elma,bulut,yazilim,bilim,astro gibi
ikinci sütuna yeni kelimeleri aynı şekilde yazın ama sonuna da yine virgül ve fazladan kelime daha ekleyin*(Düzelt için)
renolu,elmacı,bulutlu,...........gibi
Bul ve Düzlet lerin aynı sayıda olmak üzere istediğiniz kadar kelime ekleye bilirsiniz
Bu duruma göre düzeltilmiş kodlar

Sub Kelimeduzelt()
Application.DisplayAlerts = False
Documents.Open FileName:="b.doc"
Bul = Split(Documents("b.doc").Tables(1).Columns(1).Cells(1).Range.Text, ",")
Duzelt = Split(Documents("b.doc").Tables(1).Columns(2).Cells(1).Range.Text, ",")
Documents("b.doc").Close
 For i = 0 To UBound(Bul)
        With ActiveDocument.Content.Find
            .Text = Bul(i)
            .Replacement.Text = Duzelt(i)
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Application.DisplayAlerts = True
End Sub

* Nedenini çözemedim, son kelimede sorun çıkıyor. fazladan bir kelime ilave ettim.

 

[Mertsan]

Sayın Alicimri bey,

Çözümünüz için çok teşekkür ederim.
iletinizi yeni gördüm. Test edip sonucu paylaşacağım.
İyi çalışmalar dilerim.