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

sinbade · 9 Şubat 2011

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.

Kod:

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.

leumruk · 12 Şubat 2011

Merhaba,
Bu işlem için word dosyasına makro yazmanıza gerek yok. Excel üzerinden yazılacak bir kodla da istediğiniz işlemi gerçekleştirebilirsiniz. Çözüm için excel ve word dosyalarınızın örneklerini eklemelisiniz.

leumruk · 12 Şubat 2011

Ekteki excel dosyasına yazdığım kod istediğiniz işlemi gerçekleştirecektir.

Kod:

Sub degistir()
ChDir "c:\"
Set wd = CreateObject("word.Application")
wd.Visible = True
wrd = Application.GetOpenFilename(",*.doc*")
If wrd = False Then Exit Sub
wd.Application.Documents.Open wrd
    Application.DisplayAlerts = False
    For i = 1 To [a65536].End(3).Row
        With ActiveDocument.Content.Find
            .Text = Cells(i, "a")
            .Replacement.Text = Cells(i, "b")
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Application.DisplayAlerts = True
End Sub

necati · 12 Şubat 2011

Sayın Leumruk. harika bir çözüm. Tebrik ederim...

sinbade · 19 Şubat 2011

Leumruk Hocam;
Seyahatteydim, cevabım bu yüzden gecikti, özür dilerim.
Çok teşekkür ederim... Tek kelimeyle harika... Muhteşem bir çözüm olmuş.
Ellerinize sağlık.

leumruk · 19 Şubat 2011

Arkadaşlar öncelikle teşekkür ederim.
Denemelerim sırasında ilk çalıştırmada word dosyasının açılmadığını, ikinci çalıştırmada açıldığını fark ettim
Word dosyasını açan kodda küçük bir düzeltme yaptım. Dosyayı güncelledim. Kodu bu yeni şekliyle kullanmanız daha sağlıklı olacaktır.

zenira · 16 Mayıs 2011

leumruk' Alıntı:

Ekteki excel dosyasına yazdığım kod istediğiniz işlemi gerçekleştirecektir.

Kod:

Sub degistir()
ChDir "c:\"
Set wd = CreateObject("word.Application")
wd.Visible = True
wrd = Application.GetOpenFilename(",*.doc*")
If wrd = False Then Exit Sub
wd.Application.Documents.Open wrd
    Application.DisplayAlerts = False
    For i = 1 To [a65536].End(3).Row
        With ActiveDocument.Content.Find
            .Text = Cells(i, "a")
            .Replacement.Text = Cells(i, "b")
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Application.DisplayAlerts = True
End Sub

Merhaba
Ben Islem.xls'yi açamadım. office xp tr kullanıyorum. Bu hatayı veriyor:
http://img222.imagevenue.com/img.php?image=554190083_islem_hata_122_920lo.jpg

Kendim makro oluşturdum ve bu üstteki kodu yapıştırdım. başarılı olmadı. bu hatayı veriyor:
http://img138.imagevenue.com/img.php?image=541896463_hata_122_217lo.jpg

ne yapabilirim. kodu tekrar yapıştırabilir misiniz? lütfen yarım!
teşekkürler.

necati · 27 Eylül 2011

leumruk' Alıntı:

Ekteki excel dosyasına yazdığım kod istediğiniz işlemi gerçekleştirecektir.

Kod:

Sub degistir()
ChDir "c:\"
Set wd = CreateObject("word.Application")
wd.Visible = True
wrd = Application.GetOpenFilename(",*.doc*")
If wrd = False Then Exit Sub
wd.Application.Documents.Open wrd
    Application.DisplayAlerts = False
    For i = 1 To [a65536].End(3).Row
        With ActiveDocument.Content.Find
            .Text = Cells(i, "a")
            .Replacement.Text = Cells(i, "b")
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Application.DisplayAlerts = True
End Sub

Merhaba Sn. leumruk,
Yukarıdaki kodunuzda "a" kolonundaki siyah renkli veriyi "b" kolonundaki kırmızı renkli olan kelimelerle değiştirmek istediğimizde hangi değişikliği yapmalıyız? Yani word belgesinde sadece siyah renkli olanı bulup kırmızı yapacak. Diğer renkten olan kelimeye dokunmayacak.

leumruk · 27 Eylül 2011

necati' Alıntı:
Merhaba Sn. leumruk,
Yukarıdaki kodunuzda "a" kolonundaki siyah renkli veriyi "b" kolonundaki kırmızı renkli olan kelimelerle değiştirmek istediğimizde hangi değişikliği yapmalıyız? Yani word belgesinde sadece siyah renkli olanı bulup kırmızı yapacak. Diğer renkten olan kelimeye dokunmayacak.

Merhaba,
Örnek dosya ekleyebilirseniz, üzerinde çalışayım.

necati · 27 Eylül 2011

örnekler eklendi

leumruk · 28 Eylül 2011

Merhaba,
Eğer isteğinizi doğru anladıysam b sütununu kullanmanıza gerek yok. Kodu aşağıdaki gibi düzenlediğimizde sorununuz çözülecektir.

Kod:

Sub degistirgenel()
ChDir "c:\"
Set wd = CreateObject("word.Application")
wrd = Application.GetOpenFilename(",*.doc*")
If wrd = False Then Exit Sub
wd.Application.Documents.Open wrd
wd.Visible = True
    Application.DisplayAlerts = False
    wd.Selection.Find.ClearFormatting
    wd.Selection.Find.Replacement.ClearFormatting
    wd.Selection.Find.Replacement.Font.Color = wdColorRed
    MsgBox [a65536].End(3).Row
    For i = 1 To [a65536].End(3).Row
        With wd.Selection.Find
            .Text = Cells(i, "a").Text
            .Replacement.Text = ""
            .Format = True
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Application.DisplayAlerts = True
End Sub

necati · 28 Eylül 2011

Evet "b" kolonu olmasada olur. Sadece siyah renkli olanları (buradaki örnekte otomatikrenk) değiştirmesi için

Kod:

wd.Selection.Find.Font.Color = wdColorAutomatic

ekledim. Çok teşekkür ederim.

necati · 28 Eylül 2011

Küçük bir problem daha var ama çözümünün acelesi yok.
Bu makroyu çalıştırdıktan sonra word belgesini kapatırken her seferinde Normal.dot ile ilgili mesaj çıkıyor. Mesaj görüntüsü ekte.

leumruk · 28 Eylül 2011

necati' Alıntı:
Küçük bir problem daha var ama çözümünün acelesi yok.
Bu makroyu çalıştırdıktan sonra word belgesini kapatırken her seferinde Normal.dot ile ilgili mesaj çıkıyor. Mesaj görüntüsü ekte.

Bu kodlama şekliyle görüntüsünü eklediğiniz hatayı hiç almadım. Benim örneğimi denemeden önce word kodlamalarıyla ilgili denemeler yaptıysanız bilgisayar hafızasında .dot bilgisayar hafızasında açık kalmış olabilir. Eğer böyle bir sorun yaşamışsanız, bilgisayarı kapatıp açtığınızda sorun düzelecektir.
Bunun dışında aklıma gelen bir sebep yok.

necati · 28 Eylül 2011

Tamam verdiğiniz çözüm bana yeter. Bu önemli değil. Başka zaman bakarız. Tekrar teşekkür ederim.

necati · 19 Ekim 2011

leumruk' Alıntı:

Merhaba,
Eğer isteğinizi doğru anladıysam b sütununu kullanmanıza gerek yok. Kodu aşağıdaki gibi düzenlediğimizde sorununuz çözülecektir.

Kod:

Sub degistirgenel()
ChDir "c:\"
Set wd = CreateObject("word.Application")
wrd = Application.GetOpenFilename(",*.doc*")
If wrd = False Then Exit Sub
wd.Application.Documents.Open wrd
wd.Visible = True
    Application.DisplayAlerts = False
    wd.Selection.Find.ClearFormatting
    wd.Selection.Find.Replacement.ClearFormatting
    wd.Selection.Find.Replacement.Font.Color = wdColorRed
    MsgBox [a65536].End(3).Row
    For i = 1 To [a65536].End(3).Row
        With wd.Selection.Find
            .Text = Cells(i, "a").Text
            .Replacement.Text = ""
            .Format = True
            .Execute Replace:=wdReplaceAll
        End With
    Next
    Application.DisplayAlerts = True
End Sub

Merhaba,
Yukarıdaki kodu çalıştırdığımızda excel sayfasındaki satırları sayarak bir mesaj iletisi veriyor. Excel sayfasında bir satır olsa wordde bundan 150 adet değişiklik yapılsa biz mesajbox olarak 1 rakamını alıyoruz. Buna ilaveten WORD BELGESİNDE kaç adet değişiklik yaptığını da görmek istesek nasıl bir ilave yapmalıyız?

leumruk · 20 Ekim 2011

Merhaba,
Necati Bey, istediğinizi yapmak kodlarda yapılacak bir takım düzenlemelerle mümkün olabilir diye düşünüyorum. Ancak şu anki kodda bulunan veriler tek seferde değiştirme işlemini yapıyor. Düzenleme yaptığımızda değiştirilen verileri saydırabilmemiz için değiştirme teke çekmemiz gerekecek. Dolayısıyla tüm verilerin değiştirilebilmesi için Do-Loop döngüsüne girmemiz gerekecek. Bu da işlem süresini artıracaktır. Bununla birlikte değiştirilen verilerin sayısını veren bir kodlama mevcutsa döngüye gerek kalmayabilir. Ama böyle bir kod var mı bilemiyorum.

leumruk · 21 Ekim 2011

Merhaba,
Bir önceki mesajımda bahsettiğim do-loop döngüsünü kullanarak bir çözüm ürettim.

Kod:

Sub degistirgenel()
ChDir "c:\"
Set wd = CreateObject("word.Application")
wrd = Application.GetOpenFilename(",*.doc*")
If wrd = False Then Exit Sub
wd.Application.Documents.Open wrd
wd.Visible = True
    Application.DisplayAlerts = False
    wd.Selection.Find.Font.Color = &HFF000000
    For i = 1 To [a65536].End(3).Row
    With wd.Selection.Find
    Do
        .Text = Cells(i, "a").Text
        .Forward = True
        .Format = True
        .Wrap = 1
        .Execute
        If .Found = True Then
        Say = Say + 1
        wd.Selection.Font.Color = 255
        End If
    Loop While .Found = True
    End With
    If Say > 0 Then
    sonuc = sonuc & Cells(i, "a") & " : " & Say & " adet" & Chr(10)
    Say = 0
    End If
    Next
    If sonuc <> "" Then
    MsgBox sonuc & " değişiklik yapıldı."
    Else
    MsgBox " Değiştirmeye uygun veri bulunamadı."
    End If
    Application.DisplayAlerts = True
End Sub

necati · 21 Ekim 2011

Çözümünüze teşekkür ederim. Dediğiniz gibi işlem süresini artıyor. Değiştirilen verilerin sayısını tek seferde veren bir kodlama ile yapılabilir diye düşünüyordum. Ama herşeyin bir saati vardır derler.
Değiştirilecek veri sayısını teke indirmeden Replace:=wdReplaceAll komutunun sonuçlarını toplattırabileceğimiz bir kod eminim birgün ortaya çıkar. Ben bunu bekleyeceğim. Emeğinize sağlık.

pentagram_31 · 18 Şubat 2015

Merhaba, yeni bir konu açmamak için buraya yazıyorum. Sıklıkla word kullanan ve az çok makrolarla iş yapmaya çalışan birisi olarak şöyle bir ihtiyacım doğdu. Öyle bir makro olsa ki, A) ifadesini büyük harf de eşleşecek şekilde bulup üstündeki metni/soruyu seçip koyu yapsın. Umarım anlatabilmişimdir.,
Şöyle bir şey denedim ama hiçbir şey olmadı:

Kod:

Sub deneme()
'
' denemeA Makro
'
'
Find:
Selection.Find.ClearFormatting
With Selection.Find
   .Text = "A)"
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = True
   .MatchWholeWord = True
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found = True Then
   'Selection.MoveUp Unit:=wdParagraph, Count:=1
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Font.Bold = wdToggle
    End If
End Sub

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

sinbade

leumruk

Uzman

leumruk

Uzman

Ekli dosyalar

necati

sinbade

leumruk

Uzman

zenira

necati

leumruk

Uzman

necati

Ekli dosyalar

leumruk

Uzman

necati

necati

Ekli dosyalar

leumruk

Uzman

necati

necati

leumruk

Uzman

leumruk

Uzman

necati

pentagram_31