Wort-Index erstellen

Hallo zusammen,
Ich habe in einer Tabelle eine Spalte mit Erläuterungen, aus der ich (als Basis für eine Auswahlliste) einen Wortindex erstellen möchte.
Mein bisheriger Code tut eigentlich prinzipiell schon, was er soll:

Option Explicit
Sub Built_Index()
Dim Inhalt(1 To 999) As String
Dim i As Integer, j As Integer, k As Integer
Dim LZ1 As Integer, LZ2 As Integer, Zähler As Integer
j = 1
GetMoreSpeed True
For i = 2 To 241
Inhalt(j) = Worksheets("PL").Cells(i, 11)
If Inhalt(j)  "" Then
Worksheets("Tabelle1").Cells(i, 1) = Inhalt(j)
Inhalt(j) = Replace(Inhalt(j), ",", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "(", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), ")", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "/", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "-", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), ":", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "&", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), ";", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "?", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "!", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), ".", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "+", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "=", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), "", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), ">", " ", 1, -1, 1)
Inhalt(j) = Replace(Inhalt(j), " 0
Zähler = Zähler + 1
.Cells(Zähler, 3) = Mid(Inhalt(k), LZ1 + 1, LZ2 - LZ1)
LZ1 = InStr(LZ1 + 1, Inhalt(k), " ", vbTextCompare)
LZ2 = InStr(LZ2 + 1, Inhalt(k), " ", vbTextCompare)
If LZ2 = 0 And LZ1  0 Then
LZ2 = Len(Inhalt(k))
End If
Wend
End If
End If
Next
End With
GetMoreSpeed False
End Sub

Jetzt sind in der Wortliste aber etliche Einträge, die ich eliminieren möchte, z. Bsp. Artikel, Verben und andere unwichtige Wörter. Diese würde ich in einer zweiten (manuell gepflegten) Liste hinterlegen. Nun sollte mein Code vor jedem Worteintrag in dieser Liste prüfen ob das Wort dort gelistet ist und dann ggf. überspringen.
Ich hab aber nicht so richtig eine Idee, wie man das innerhalb des bestehenden Codes integriert. Meine Lösung wäre, dass ich die fertige Liste nochmal durchgehe, was aber natürlich ziemlich redundant ist und Performance kostet.
Vielleicht hat jemand eine Anregung, wie ich da ran gehen könnte. Auch für Optimierungsvorschläge für den bisherigen Code bin ich auf jeden Fall offen.
Gruß
David

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Built_Index() Dim Inhalt() As String Dim i As Long, j As Long, k As Long Dim iIndex As Long Dim rngFinden As Range, Zähler As Long, varSplit j = 1 With Worksheets("PL") k = .Cells(.Rows.Count, 11).End(xlUp).Row ReDim Inhalt(1 To k) End With GetMoreSpeed True For i = 2 To k Inhalt(j) = Worksheets("PL").Cells(i, 11) If Inhalt(j) "" Then Worksheets("Tabelle1").Cells(i, 1) = Inhalt(j) 'Sonderzeichen durch Leerzeichen ersetzen For k = 33 To 131 Select Case k Case 32 To 47, 58 To 64, 91 To 94, 123 To 130 ' " " bis "/", ":" bis "@", _ "[" bis "^", "{" bis "," Inhalt(j) = Replace(Inhalt(j), Chr(k), " ", 1, -1, 1) Case 48 To 57 '"0" bis "9" Case 65 To 90, 95 To 122 '"A" bis "Z", "_" bis "z" Case 131 To 254 'internationale Zeichen, Umlaute etc End Select Next 'Doppelte Leerzeichen durch ein Leerzeichen ersetzen Do Until InStr(1, Inhalt(j), " ") = 0 Inhalt(j) = Replace(Inhalt(j), " ", " ", 1, -1, 1) Loop Inhalt(j) = Trim(Inhalt(j)) '.Cells(i, 2) = Inhalt(j) j = j + 1 End If Next Zähler = 0 With Worksheets("Ausnahmen") With .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)) For k = 1 To UBound(Inhalt) varSplit = Split(Inhalt(k), " ") For iIndex = 0 To UBound(varSplit) 'Wort in Liste der Ausnahmen suchen Set rngFinden = .Find(What:=varSplit(iIndex), _ lookat:=xlWhole, LookIn:=xlValues) With Worksheets("Tabelle1") If rngFinden Is Nothing Then If Zähler = 0 Then '1. Index-Eintrag Zähler = Zähler + 1 .Cells(Zähler, 3) = varSplit(iIndex) ElseIf Application.WorksheetFunction.CountIf(.Range(.Cells(1, 3), _ .Cells(Zähler, 3)), varSplit(iIndex)) = 0 Then 'Wort noch nicht vorhanden Zähler = Zähler + 1 .Cells(Zähler, 3) = varSplit(iIndex) End If End If End With Next Next End With End With 'Index sortieren With Worksheets("Tabelle1") If Zähler > 1 Then With .Range(.Cells(1, 3), .Cells(Zähler, 3)) .Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo End With End If End With GetMoreSpeed False End Sub

Hallo Franz,
das funzt prima. Einigermaßen verstanden hab ich's auch. Wenn ich die Funktion "split" gekannt hätte, hätte ich mir eine Menge Bastelei ersparen können. Und auch dein Ansatz für die Filterung der unerwünschten Zeichen ist klasse. Da für den Index enthaltene Zahlen unwichtig sind, könnten die auch rausfliegen. Ich habe dazu die Zeile

Case 32 To 47, 58 To 64, 91 To 94, 123 To 130

ersetzt durch

Case 32 To 64, 91 To 94, 123 To 130

und

Case 48 To 57 '"0" bis "9"

auskommentiert.
Ich habe momentan noch nicht den echten Datenbestand. Eventuell könnte man es als sinnvoll erachten, in den Index nur Substantive aufzunehmen, Kriterium wäre dann der Anfangsbuchstabe. Wenn groß, dann mitnehmen, wenn klein, dann weglassen. Dann würde sich vermutlich auch die Ausnahmeliste erledigen.
Ich hätte jetzt nur die Idee, das direkt vor dem Eintragen zu prüfen, also in den beiden Zeilen

.Cells(Zähler, 3) = varSplit(iIndex)

noch eine Wenn-Dann-Bedingung einzubauen oder vielleicht hinterher noch mal eine Routine über die ganze Liste laufen zu lassen - aber du hast sicher eine elegantere Lösung. ;-)
Auf jeden Fall schon mal vielen Dank bis hierher.
Gruß
David

With Worksheets("Tabelle1") If rngFinden Is Nothing Then Select Case Asc(Left(varSplit(iIndex), 1)) Case 65 To 90, 192 To 221 'A-Z und große internationale Buchstaben If Zähler = 0 Then '1. Index-Eintrag Zähler = Zähler + 1 .Cells(Zähler, 3) = varSplit(iIndex) ElseIf Application.WorksheetFunction.CountIf(.Range(.Cells(1, 3), _ .Cells(Zähler, 3)), varSplit(iIndex)) = 0 Then 'Wort noch nicht vorhanden Zähler = Zähler + 1 .Cells(Zähler, 3) = varSplit(iIndex) End If End Select End If End With

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread