Moin,
folgendes Problem, ich habe eine Liste mit Wörtern, zu den ich mir gerne die Synonyme ausgeben lassen würde.
Die Wörter stehen in Spalte A1:A1543 und sollen dann um den Inhalt in den Spalten B,C&D ergänzt w
|
A |
B |
C |
D |
|
Ausgangswort |
syn1 |
syn2 |
syn3 |
1 |
Gebäude |
Haus |
Häuser |
Bau |
2 |
Heizung |
Ofen |
Heizkörper |
Radiator |
3 |
Schloss |
Palais |
Palast |
Burg |
4 |
Lüftung |
… |
|
|
5 |
energetisch |
... |
|
|
... |
... |
|
|
|
Ich habe es hiermit in Word probiert
Sub GetSynonyms()
Dim msg As String
Dim var
Dim i As Long
Dim mySi As SynonymInfo
Dim synList() As String
Selection.Expand Unit:=wdWord
Set mySi = Selection.Range.SynonymInfo
For var = 1 To 1
synList = mySi.SynonymList(Meaning:=var)
For i = 1 To 3
iSynonyms = iSynonyms & synList(i) & ", "
Next i
Next
Debug.Print iSynonyms
End Sub
Der Code stammt von folgender Seite https://www.mrexcel.com/forum/excel-questions/894170-find-synonyms-word-ms-excel-using-vba.htmlSub GetSynonyms()
In Zeile 8 "Set mySi = Selection.Range.SynonymInfo" bekomme ich nur einen Run-time error 5843 und habe keine Ahnung warum.
Dem Threadersteller des Links oben hat folgendes weitergeholfen
https://www.mrexcel.com/forum/general-excel-discussion-other-questions/559715-parts-speech-wordlist-excel-using-vba.html
Option Explicit
Public Sub PartsOfSpeech()
Dim mObjWord As Word.Application
Dim mySynInfo As Word.SynonymInfo
Dim myList As Variant
Dim myPos As Variant
Dim i As Integer
Dim iMax As Integer
Dim thisPos As String
Dim oCell As Range
Set mObjWord = CreateObject("Word.Application")
iMax = 1
For Each oCell In Selection
oCell.Offset(0, 1).Resize(1, 99).ClearContents
If oCell.Column = 1 And Not IsEmpty(oCell) Then
Set mySynInfo = SynonymInfo(Word:=oCell.Value, LanguageID:=wdEnglishUS)
oCell.Offset(0, 1) = "'(" & CStr(mySynInfo.MeaningCount) & ")"
If mySynInfo.MeaningCount <> 0 Then
myList = mySynInfo.MeaningList
myPos = mySynInfo.PartOfSpeechList
If i > iMax Then iMax = i
For i = 1 To UBound(myPos)
Select Case myPos(i)
Case wdAdjective
thisPos = "adjective"
Case wdNoun
thisPos = "noun"
Case wdAdverb
thisPos = "adverb"
Case wdVerb
thisPos = "verb"
Case wdConjunction
thisPos = "conjunction"
Case wdIdiom
thisPos = "idiom"
Case wdInterjection
thisPos = "interjection"
Case wdPreposition
thisPos = "preposition"
Case wdPronoun
thisPos = "pronoun"
Case Else
thisPos = "other"
End Select
oCell.Offset(0, i + 1) = myList(i) & " (" & thisPos & ")"
Next i
Else
oCell.Offset(0, 2) = "No meanings found"
End If
End If
Next oCell
For i = 3 To iMax
Columns(i).EntireColumn.AutoFit
Next i
End Sub
Also zu Excel gewechselt, aber dabei bekomme ich, wie es der Titel schon sagt, nur die POS Tags, nicht aber die Synonyme
Das hier funktioniert tatsächlich, nur leider nicht in einer für mich brauchbaren Form
Dim wdApp As Word.Application
Public Sub SynonymFind()
vColumn = Left(Columns(ActiveCell.Column).Address(0, 0), 2 + (ActiveCell.Column < 27))
Set wdApp = New Word.Application
wdApp.Visible = True
wdApp.Documents.Add DocumentType:=wdNewBlankDocument
Do While ActiveCell.Row <= Cells(Rows.Count, vColumn).End(xlUp).Row
On Error GoTo NextWord
vSyn = Application.Proper(ActiveCell.Text)
If wdApp.SynonymInfo(Word:=vSyn, LanguageID:=wdGerman).Found = True _
And wdApp.SynonymInfo(Word:=vSyn, LanguageID:=wdGerman).MeaningCount > 0 Then
vList = SynonymInfo(Word:=vSyn, LanguageID:=wdGerman).SynonymList(1)
wdApp.Selection.TypeText Text:="The Synonyms for "
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:=vSyn & ": "
wdApp.Selection.Font.Bold = wdToggle
For i = 1 To UBound(vList)
If i = UBound(vList) Then
wdApp.Selection.TypeText Application.Proper(vList(i))
Else
wdApp.Selection.TypeText Application.Proper(vList(i)) & " "
End If
Next i
End If
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
NextWord:
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Zu erst habe ich das ganze Unterfangen in R probiert mit "tidyverse" und "qdap" bin dabei aber an der deutschen Sprache gescheitert.
Also wenn irgendjemand mir weiterhelfen kann, ob in R, Excel oder Word, wäre ich unendlich dankbar, weil ich wirklich kaum Ahnung von VBA habe und einfach nicht mehr weiterkomme.
Vielen Dank schonmal im Vorraus!!
|