• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

S

sinbade

Katılım
2 Nisan 2005
Mesajlar
191
Excel Vers. ve Dili
Office 2007 English
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.
 
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.
 
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
 

Ekli dosyalar

Sayın Leumruk. harika bir çözüm. Tebrik ederim...
 
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.
 
Son düzenleme:
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.
 
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
Genişletmek için tıkla ...

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.
 
Son düzenleme:
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
Genişletmek için tıkla ...

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.
 
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.
Genişletmek için tıkla ...
Merhaba,
Örnek dosya ekleyebilirseniz, üzerinde çalışayım.
 
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
 
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.
 
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.
 

Ekli dosyalar

  • mesaj.jpg
    mesaj.jpg
    7 KB · Görüntüleme: 7
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.
Genişletmek için tıkla ...
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.
 
Tamam verdiğiniz çözüm bana yeter. Bu önemli değil. Başka zaman bakarız. Tekrar teşekkür ederim.
 
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
Genişletmek için tıkla ...

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?
 
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.
 
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
 
Çö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.
 
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
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst