Zeichenketten mit * oder

Hallo Alle!
Ich möchte "*etzen" = hinsetzen, übersetzen... aus Textdatei rausholen, aber ich bekomme nur die exakte Kette mit Stern, was ich im Text natürlich nicht habe.
Was mache ich falsch? Excel-Tabelle und "*.txt" für "C:\" lege ich bei. Vielen Dank für Eure Hilfe im Voraus!!!!

https://www.herber.de/bbs/user/162235.xlsm

Hier ist der Code, wenn man die Dateien nicht laden möchte:


Sub Rausholen()

'

Dim QuellDatei, DasGesuchte, Trennung As String



QuellDatei = "C:\Rausholen.txt"

DasGesuchte = Range("C10").Value '"*etzen" ' oder " ???setzen"  ' nOK und setzen = OK

Trennung = "."

            

            Range("A1:A15").Clear

            Range("A1").Select

            

            Open QuellDatei For Input As #1



            Do While Not EOF(1)

                ' durchsucht alle Zeilen nach ";*etzen" oder " ???setzen":

                Line Input #1, InhaltsZeile ' = Inhalt rausholen

'Stop

                ' Suchen die Zeile des Inhalts wo DasGESUCHTE ist:

                ' 2022-03-11 LCase = Groß und klein Schreibung ignorieren:

                ' aber sucht exakte schreibweise! D.h. "*" oder "?" als Zeichen in der Kette!

                'Die InStr Funktion liefert die Position einer Zeichenfolge_

                'in der angegebenen Zeichenfolge zurück.

                 If InStr(LCase(InhaltsZeile), LCase(DasGesuchte)) Then

'MsgBox DasGesuchte

'Stop

                SpaltenNr = ActiveCell.Column

                'Letzte Zelle mit Inhalt in der aktuelen Spalte:

                ZeilenAnzahl = Cells(Rows.Count, SpaltenNr).End(xlUp).Row



                ' SOLL: Letzte leere Zelle finden und markieren:

                strAktuelleSpalte = Split(ActiveCell.Address, "$")(1)   'Buchstabe "B" = 2.Spalte



                ' eintragen und hinter dem "Trennzeichen" abschneiden:

                Range(strAktuelleSpalte & ZeilenAnzahl + 1) = Split(InhaltsZeile, Trennung)

'Stop

                End If

            Loop    ' alles Gesuchte ist ausgelesen.

        Close #1    ' Quelldatei schließen.

        

        Cells.Replace What:="Irgendwas ", Replacement:="", LookAt:=xlPart

        

        MsgBox "TXT durchgesucht! Nichts gefunden? Exakte schreibweise?"

End Sub

\pre>



TXT:

Irgendwas legen

Irgendwas holen. Und weiter...

Irgendwas  ;setzen

Irgendwas  schlaffen

Irgendwas  putzen

Irgendwas ;; übersetzen. Und weiter...

Irgendwas versetzen

Irgendwas  Durchsetzen

Irgendwas ; Aufsetzen. Und weiter...

Irgendwas werfen

Irgendwas  absetzen

Irgendwas fliegen

Irgendwas ;  Besetzen. Und weiter...

Irgendwas ; gießen

Irgendwas hinsetzen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Ersetzen() Dim vntDaten, vntTmpA, vntTmpB Dim strTMP As String Dim i As Integer, j As Integer, k As Integer Dim blnFound As Boolean Const Trenner = "." Const strSUCH = "etzen" Const strERSA = "hinsetzen" Range("A:B").ClearContents Open "c:\test\rausholen.txt" For Input As #1 Do While Not EOF(1) Line Input #1, strTMP vntDaten = vntDaten & vbCrLf & strTMP Loop Close #1 vntDaten = Mid(vntDaten, 2) vntDaten = Split(vntDaten, vbCrLf) For i = 0 To UBound(vntDaten) vntTmpA = Split(vntDaten(i), Trenner) blnFound = False For j = 0 To UBound(vntTmpA) vntTmpB = Split(vntTmpA(j)) For k = 0 To UBound(vntTmpB) If LCase(vntTmpB(k)) Like LCase("*" & strSUCH) Then vntTmpB(k) = strERSA blnFound = True End If Next k vntTmpA(j) = Join(vntTmpB) Next j If blnFound Then Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(vntTmpA) + 1) = vntTmpA End If Next i End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeichenketten mit * oder

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread