Soru Word Makro

[Bagcivan]

Selamlar,
75 sayfalık bir word dosyasında, metinin içerisinde bazı kelimeler parantez içinde yazılı. Bunları oradan alıp, dipnot olarak eklemem gerekiyor.
Word dosyasında bu mümkün mü?
Aşağıdaki örnek gibi.

Lorem ipsum dolor sit amet, consectetur (adipiscing) elit. Phasellus commodo convallis sollicitudin. Vivamus (nec) sapien consectetur, feugiat nibh in, finibus nunc. Mauris interdum, nisl et efficitur imperdiet, mauris orci efficitur sapien, ut (pharetra) mi leo eu nunc. Nunc non urna vitae odio pellentesque sodales non in eros. Maecenas auctor lorem in iaculis commodo. Fusce elementum quam eu (odio) lobortis, ut luctus elit sagittis. Cras egestas eu dui eget aliquam. Aliquam (eros) orci, ullamcorper in sodales sed, malesuada a nisi.

 

[kulomer46]

Merhaba

75 sayfalık word dosyanızın tamamını kopyalayıp boş bir excel sayfasının A sütununa yapıştırınız (Tercihen Sayfa1 olsun).

Aşağıdaki makro kodunu modül olarak bu Excel dosyanıza ekleyip çalıştırınız.
Makro parantez içine yazılı kelimeleri Sayfa2 'de alt alta sıralayacaktır (Dosyanızda Sayfa2 adlı bir sayfa bulunsun).
Ordan kopyalayıp dilediğiniz gibi kullanabilirsiniz.

İşlemi yapan dosyada ayrıca Ek' tedir.

Selamlar...

Sub Aktar()
'13.01.2020  16 02

sona = Cells(Rows.Count, 1).End(3).Row
Application.ScreenUpdating = False

Sheets("Sayfa2").Select
Cells.ClearContents
Sheets("Sayfa1").Select

Application.ScreenUpdating = True

For i = 1 To sona
    If Len(Trim(Cells(i, 1))) > 0 Then
        For j = 1 To Len(Cells(i, 1))  
       
            If Mid(Cells(i, 1), j, 1) = "(" Then     
'                MsgBox " (   Satır " & i & "   Karakter Sıra " & j     
                ilk = j
            End If
         
            If Mid(Cells(i, 1), j, 1) = ")" Then         
'                    MsgBox " )   Satır " & i & "   Karakter Sıra " & j     
                    son = j             
                    sonb = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row + 1             
                    Sheets("Sayfa2").Cells(sonb, 1) = Mid(Cells(i, 1), ilk, son - ilk + 1)             
                    say = say + 1     
            End If
 
        Next
    End If
Next

Sheets("Sayfa2").Select

If say > 0 Then
    MsgBox "Sayfa1 A Sütununda " & say & " Adet Parantez arası" & Chr(10) & Chr(10) & "metin bulundu ve bu sayfaya aktarıldı"
Else
     MsgBox "Sayfa1 A Sütununda Parantez arası metin bulunmamaktadır"
End If

End Sub

 

[Haluk]

İstediğiniz ekli Word dokümanındaki gibi birşey mi?

Dosyadaki "Test" isimli makroyu çalıştırdığınzda, dokümandaki tüm parantez içindeki ifadeler numaralandırılarak sayfanın altında dipnot olarak belirtilir....

.

 

[Bagcivan]

İstediğiniz ekli Word dokümanındaki gibi birşey mi?

Dosyadaki "Test" isimli makroyu çalıştırdığınzda, dokümandaki tüm parantez içindeki ifadeler numaralandırılarak sayfanın altında dipnot olarak beliritilir....

Test.docm

drive.google.com

.

Haluk bey,
Evet aramadığım şey bu minvalde.
Dosyamdaki parantezler köşeli ve o parantez içerisindeki metinleri de ana metinden silmek istiyorum. Bu konuda yardımcı olabilir misiniz?
İlginiz için teşekkür ederim

 

[Haluk]

"Aramadığım şey...." derken ne demek istediniz anlamadım.

Örnek bir dosya eklerseniz, duruma bakabilirim. İstediğiniz şey yapılabilir görünüyor....

Parantez içindeki metinler silinip, dipnot olarak mı ilave edilecek, onu anlamadım ?

.

 

[Bagcivan]

Kusura bakmayın yazım yanlışı yapmışım. "Aradığım" olacaktı.

Evet söylediğiniz gibi. Parantez içindeki metinler silinip, dipnot olarak yazılacak.

Örnek aşağıdaki gibidir.

Örnek.docx

drive.google.com

 

[Haluk]

Ekli dosyayı inceleyin, umarım işinize yarar....

.

 

[Bagcivan]

Haluk bey,
Çok teşekkür ederim. Size minnettarım.

Son olarak, dipnot olarak eklenen kelimelerin başından parantezleri nasıl silebilirim.

 

[Haluk]

7. mesajdaki dosya, bu duruma göre revize edildi ....

.

 

[Bagcivan]

Haluk bey,

Ne kadar teşekkür etsem az kalır.

İyi ki varsınız