Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
Przesunięty przez: Artik
24-02-2019, 00:48
Wyszukiwanie dubli w tekście dokumentu word.
Autor Wiadomość
szunaj85 
Exceloholic


Posty: 117
Wysłany: 23-02-2019, 11:11   Wyszukiwanie dubli w tekście dokumentu word.

W dokumencie worda mam tekst, normalne zdania. Szukam jakiegoś makra lub innego rozwiązani, które będzie przeszukiwać cały ten tekst i podświetlać wszystkie słowa występujące 2 lub więcej razy. Poniżej przykład. Trzeba zwrócić uwagę, że nie zawsze duble są oddzielone spacjami i mogą różnić się wielkością znaków.

Ala ma czarnego kota.
Kota? A ona nie ma psa?
ID posta: 363152 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2644 razy
Posty: 8761
Wysłany: 24-02-2019, 00:54   

Mniej więcej coś takiego:
Kod:
Sub PodswietlDuplikaty()
    Dim dictNew     As Scripting.Dictionary
    Dim oWord       As Range
    Dim strText     As String
    Dim i           As Long
    Dim myRange     As Range
    Dim blnExec     As Boolean
    Dim iWordCount  As Long

    Set myRange = ActiveDocument.Content
    iWordCount = myRange.Words.Count

    Set dictNew = New Scripting.Dictionary
   
    ' biegaj po wszystkich słowach w dokumencie
    For Each oWord In myRange.Words
        i = i + 1

        If i Mod 50 = 0 Then
            Application.StatusBar = i & "/" & iWordCount
            DoEvents
        End If

        'usuń spacje i wszystko małymi literami
        strText = LCase(Trim(oWord.Text))
        'nie przetwarzaj spójników i znaków interpunkcyjnych
        If Len(strText) > 1 Then
            'sprawdź czy słowo jest już w słowniku...
            If Not dictNew.Exists(strText) Then
                '...nie ma jeszcze, więc dodaj do słownika
                dictNew.Add strText, 1
            Else
                '...już jest, więc inkrementuj liczbę wystąpień
                dictNew(strText) = dictNew(strText) + 1
            End If

        End If

        If i > iWordCount Then Exit For
    Next oWord

    Application.StatusBar = vbNullString

    'usuń ze słownika słowa, które się nie powtarzają w dokumencie
    For i = UBound(dictNew.Items) To LBound(dictNew.Items) Step -1
        If dictNew.Items(i) < 2 Then
            dictNew.Remove dictNew.Keys(i)
        End If
    Next i

    'w tej chwili słownik przechowuje tylko słowa-duplikaty

    iWordCount = UBound(dictNew.Items) + 1
   
    'biegaj po słowach-duplikatach w słowniku
    For i = 0 To UBound(dictNew.Items)
        'i = i + 1

        If i Mod 5 = 0 Then
            Application.StatusBar = i + 1 & "/" & iWordCount
            DoEvents
        End If

        Set myRange = ActiveDocument.Content

        'wyszukaj i podświetl wszystkie wystąpienia badanego słowa-duplikatu
        Do
            blnExec = myRange.Find.Execute(FindText:=dictNew.Keys(i), MatchCase:=False, MatchWholeWord:=True, Forward:=True)
            If blnExec Then myRange.HighlightColorIndex = wdPink
        Loop While blnExec

    Next i
   
    Application.StatusBar = vbNullString

    MsgBox "Gotowe"
End Sub


Sub UsunPodswietlenie()
    Dim myRange     As Range

    Set myRange = ActiveDocument.Content
    myRange.HighlightColorIndex = wdNoHighlight
End Sub
Przed uruchomieniem należy utworzyć referencję do biblioteki Microsoft Scripting Runtime

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 363167 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 198 razy
Posty: 938
Wysłany: 24-02-2019, 02:29   

szunaj85 napisał/a:
wszystkie słowa występujące 2 lub więcej razy

A co z: a, i, o, u, w, z ... znaczy się ze spójnikami/partykułami/przyimkami ... czy jakoś tak ? :->
ID posta: 363169 Skopiuj do schowka
 
 
szunaj85 
Exceloholic


Posty: 117
Wysłany: 24-02-2019, 11:03   

Nie są tak istotne. Głównie chodzi o słowa które mają minimum 2 znaki.
ID posta: 363177 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe