Zeichenketten mit * oder

Forumthread: Zeichenketten mit * oder

08.08.2023 14:09:13

Igor (UA)

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

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeichenketten mit * oder

08.08.2023 14:31:48

onur
Zeichenketten mit * oder

08.08.2023 14:49:52

Rudi Maintaire

AW: Zeichenketten mit * oder

08.08.2023 14:31:48

onur

Wozu auch noch Sternchen? Du suchst doch schon mit InStr, dem es egal ist, was VOR (oder nach) dem String kommt.....

Zeichenketten mit * oder

08.08.2023 14:49:52

Rudi Maintaire

Hallo,
als Anregung:

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

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Forumthread: Zeichenketten mit * oder

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

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread