Thema Datum  Von Nutzer Rating
Antwort
11.01.2024 08:25:35 Kim
NotSolved
Blau Suchen, markieren, kopieren in Spalten
11.01.2024 11:51:11 Gast15472
NotSolved
11.01.2024 18:50:15 Kim
NotSolved
12.01.2024 06:36:11 Gast8849
NotSolved
12.01.2024 10:11:40 Kim
NotSolved
15.01.2024 08:49:53 Kim
NotSolved
20.01.2024 11:08:44 Gast57962
NotSolved

Ansicht des Beitrags:
Von:
Gast15472
Datum:
11.01.2024 11:51:11
Views:
184
Rating: Antwort:
  Ja
Thema:
Suchen, markieren, kopieren in Spalten

Als erstes würde ich vorschlagen...
Auftrennen in einzelne Operationen:

  1. Zurücksetzen aller vorgenommenen Markierungen
  2. Eingabe durch Benutzer (Suchworte/Schlagworte)
  3. Text-Vorkommen in einem Bereich markieren
  4. Text-Vorkommen in einer Zelle markieren

Ich habe die Methodennamen hier ausnamsweise mal in deutsch belassen. Normalerweise würde ich das nicht tun, weil es den Lesefluss stört. Gleiches gilt für Kommentare und Variablennamen.

Option Explicit

Public Sub SucheUndMarkiere()
  
  Dim vntSchlagworte As Variant
  If Not CBool(ErfrageSchlagworte(vntSchlagworte)) Then
    Exit Sub
  End If
  
  Dim wks As Excel.Worksheet
  Set wks = Worksheets("Tabelle1") '<< ggf. anpassen
  
  Call Reset(wks.Range("A:A,M:N"))
  
  Dim strSchlagwort As String
  Dim i As Long
  
  For i = LBound(vntSchlagworte) To UBound(vntSchlagworte)
    strSchlagwort = Trim$(vntSchlagworte(i))
    Call MarkiereTextInBereich(strSchlagwort, wks.Range("M:N"), rgbRed)
  Next
  
End Sub

Private Sub Reset(Bereich As Excel.Range)
  Bereich.Font.ColorIndex = xlAutomatic
End Function

Private Function ErfrageSchlagworte(ByRef Schlagworte As Variant) As Long
  
  Dim vntSchlagworte As Variant
  
  vntSchlagworte = InputBox( _
    Title:="Suche", _
    Prompt:="Bitte geben Sie die Suchbegriffe ein." & vbNewLine _
            & "Trennen Sie die Suchbegriffe mit einem Schrägstrich  / ")
  
  vntSchlagworte = Trim$(vntSchlagworte)
  ' Nutzer hat nichts eingegeben, oder er hat abgebrochen
  If Len(vntSchlagworte) = 0 Then
    ' erzeugt ein leeres Array
    Schlagworte = Split(Empty)
    'ErfrageSchlagworte = 0
    Exit Function
  End If
  
  ' Split() erzeugt ein Array von 0..k
  Schlagworte = Split(vntSchlagworte, "/")
  ' ... um die Anzahl (n) zu erhalten,
  ' addieren wir deshalb eine Eins auf die obere Grenze
  ErfrageSchlagworte = UBound(Schlagworte) + 1
  
End Function

Private Sub MarkiereTextInBereich(Text As String, Bereich As Excel.Range, Color As Excel.XlRgbColor)
  Dim strErsterTreffer As String
  Dim rngZelle As Excel.Range
  Set rngZelle = Bereich.Find(Text, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False)
  If Not rngZelle Is Nothing Then
    strErsterTreffer = rngZelle.Address
    Do
      Call MarkiereTextInZelle(Text, rngZelle, Color)
      Set rngZelle = Bereich.FindNext(rngZelle)
    Loop While rngZelle.Address <> strErsterTreffer
  End If
End Sub

Private Sub MarkiereTextInZelle(Text As String, Cell As Excel.Range, Color As Excel.XlRgbColor)
  Dim rngZelle As Excel.Range
  Dim i As Long, n As Long
  'falls entgegen der Erwartung ein Bereich übergeben wurde,
  'berücksichtigen wir davon nur die erste Zelle
  Set rngZelle = Cell(1)
  n = Len(Text)
  i = InStr(rngZelle.Value, Text)
  Do While i > 0
    rngZelle.Characters(i, n).Font.Color = Color
    i = InStr(i + n, rngZelle.Value, Text)
  Loop
End Sub

 

Und jetzt überleg mal...

... an welcher Stelle könntest du den bestehenden Code erweitern, um in Spalte A gefundene Schlagworte zu vermerken. (übrigens: es gibt mindestens zwei Möglichkeiten)

... an welcher Stelle müsstest du den Code ergänzen, um die Inhalt in Spalte A zurück zu setzen.

 

Grüße


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
11.01.2024 08:25:35 Kim
NotSolved
Blau Suchen, markieren, kopieren in Spalten
11.01.2024 11:51:11 Gast15472
NotSolved
11.01.2024 18:50:15 Kim
NotSolved
12.01.2024 06:36:11 Gast8849
NotSolved
12.01.2024 10:11:40 Kim
NotSolved
15.01.2024 08:49:53 Kim
NotSolved
20.01.2024 11:08:44 Gast57962
NotSolved