Thema Datum  Von Nutzer Rating
Antwort
05.09.2023 10:55:53 Lisa
Solved
05.09.2023 11:01:38 Gast60289
Solved
05.09.2023 11:07:56 Gast5432
Solved
05.09.2023 14:39:32 Gast93377
NotSolved
05.09.2023 15:23:32 Gast51240
NotSolved
05.09.2023 15:45:28 Gast54981
NotSolved
Rot Viele Zellen Vergleichen
05.09.2023 21:35:58 Gast51346
NotSolved
06.09.2023 08:16:03 Gast15743
NotSolved

Ansicht des Beitrags:
Von:
Gast51346
Datum:
05.09.2023 21:35:58
Views:
203
Rating: Antwort:
  Ja
Thema:
Viele Zellen Vergleichen

HalloLisa

oder etwas überschaubarerer Code für Färbung der Suchbegriffe bezogen auf einmaligkeit jedes Begriffes!

Sub Suchen()
Application.ScreenUpdating = False
Dim Qarr As Variant, Barr As Variant
Dim ZeileA As Long, ZeileB As Long
Dim Wks1 As Worksheet, Wks2 As Worksheet, Wks3 As Worksheet
Set Wks1 = Worksheets("Tabelle1")
Set Wks2 = Worksheets("Tabelle2")
Set Wks3 = Worksheets("Tabelle3")
Wks1.Range("A2:A" & Wks1.Range(Wks1.Cells(Rows.Count, 1), Wks1.Cells(Rows.Count, 1)).End(xlUp).Row).Font.ColorIndex = 0
Qarr = Wks1.Range("A2:A" & Wks1.Range(Worksheets("Tabelle1").Cells(Rows.Count, 1), Wks1.Cells(Rows.Count, 1)).End(xlUp).Row)
Barr = Wks2.Range("A2:A" & Wks2.Range(Worksheets("Tabelle2").Cells(Rows.Count, 1), Wks2.Cells(Rows.Count, 1)).End(xlUp).Row)
 For ZeileA = 1 To UBound(Qarr)
  For ZeileB = 1 To UBound(Barr)
   If InStr(1, Qarr(ZeileA, 1), Barr(ZeileB, 1)) > 0 Then
    Wks1.Cells(ZeileA + 1, 1).Characters(Start:=InStr(1, Qarr(ZeileA, 1), Barr(ZeileB, 1)), Length:=Len(Barr(ZeileB, 1))).Font.ColorIndex = 4
    Wks1.Cells(ZeileA + 1, 1).Copy Wks3.Cells(Wks3.Range(Wks3.Cells(Rows.Count, 1), Wks3.Cells(Rows.Count, 1)).End(xlUp).Row + 1, 1)
   End If
  Next ZeileB
 Next ZeileA
Application.ScreenUpdating = True
End Sub

 


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
05.09.2023 10:55:53 Lisa
Solved
05.09.2023 11:01:38 Gast60289
Solved
05.09.2023 11:07:56 Gast5432
Solved
05.09.2023 14:39:32 Gast93377
NotSolved
05.09.2023 15:23:32 Gast51240
NotSolved
05.09.2023 15:45:28 Gast54981
NotSolved
Rot Viele Zellen Vergleichen
05.09.2023 21:35:58 Gast51346
NotSolved
06.09.2023 08:16:03 Gast15743
NotSolved