Office: Bestimmte Textstellen nach mehreren Bedingungen durchsuchen

Hallo liebes Community,

ich bin relativ frisch was VBA angeht, daher fehlen mir viele viele Informationen wie ich mein Problem zu lösen habe.

Ich habe eine Spalte z.B. mit 100 unabhängigen Suchbedingungen und eine weitere Spalte mit verschiedenen Textstellen. Die Spalte mit den verschiedenen Textstellen sollen nach diesen Suchbedingungen durchsucht werden. Falls einer der Bedingungen erfüllt sein soll, soll genau die Suchbedingung in der Zeile neben der Beschreibung hinzugefügt werden (Stichwort: Daten extrahieren)

Beispiel:
Suchbedingungen:
Blau
Grün
Gelb
Rot

Textstellen:

Auto Rot 5-Türer ---> Treffer ---> Zeile daneben : Rot
Fahrrad E-Bike -----> kein Treffer
T-Shirt Gelb ----> Treffer ----> Zeile daneben: Gelb

Kann mir jemand weiterhelfen ? :/ Würde mich echt freuen

Liebe Grüße und vielen Dank im Voraus !!

:)

 

if Instr(cells(loi,1),"Blau")>0 then
cells(loi,1).offset(0,1)="Blau"
elseif Instr(cells(loi,1),"Grün")>0 then
cells(loi,1).offset(0,1)="Grün"
elseif Instr(cells(loi,1),"Gelb") >0then
cells(loi,1).offset(0,1)="Gelb"
elseif Instr(cells(loi,1),"Rot")>0 then
cells(loi,1).offset(0,1)="Rot"
End if

Zu Deiner Datei kann ich nichts schreiben, was wohl daran liegt das ich nicht auf fremde Rechner schaue. Ich baue keine Datei nach.

Sollte die Datei verlinkt werden?

Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.

Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Bilder statt Datei | Excel ist sexy!

Es sollte ein aussagekräftiger Name sein.

Das ist nur meine Meinung zu dem Thema.

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
http://www.ms-office-forum.de/forum/...d.php?t=322895
ändern.

Das ist nur meine Meinung zu dem Thema.

Bitte berücksichtige das Themen die Erledigt sind als Erledigt markiert werden können. Also mache es unten links mit Klick auf den Schalter "als erledigt setzen", falls Problem gelöst.
Der Zustand des Beitrages wird dann in der Übersicht angezeigt und man braucht sich diese Beiträge nicht mehr ansehen.





Meine Homepage Homeseite - Hajo's Excelseiten

 

Hallo,

Suchbedingungen in welcher Spalte ab welcher Zeile? Texte in welcher Spalte? Beides auf dem selben Tabellenblatt?

 

Hallo,

so könnte es gehen.
Code:

Text in dem gesucht wird in Spalte A (1), Suchbegriffe in Spalte G (7),
Ergebnisse werden in Spalte B (2) eingetragen.
Geht sicherlich eleganter, klappt aber!

Gruß Achim

 

Hallo zusammen,

vielen Dank für die Antworten. Vielleicht sollte ich etwas spezifischer werden:

Ich habe zwei Tabellenblätter (Input)

1. Tabellenblatt: Beinhaltet z.B. die Artikelbeschreibungen, die nach bestimmten Suchkriterien durchsucht werden sollen ( kann auch größer 30.000 Artikelbeschreibungen sein) ---> Spalte A2:A30002

2. Tabellenblatt: Beinhaltet bestimmte Suchkriterien, wie z.B. Farbe, Material, Größe etc. Ich habe insgesamt 350 Suchkriterien in den Spalten:
A2:A100 Farben
B2:B200 Größen
C2:C50 Material

Output:

Mein Output soll im ersten Tabellenblatt in der Spalte B2:B30002 (Farbe), C2:C30002 (Größe), D2:30002(Material) erzeugt werden, d.h.:

Beispiel für die Farbe:
Die Artikelbeschreibung soll nach den Farben aus dem 2. Tabellenblatt (Spalte A2:A100) durchsucht werden. Falls z.B. im Tabellenblatt 1 in der Zelle A2 "Blue Jeans Gr. 30-30" steht und in den Suchkriterien "Blue" enthalten ist, soll in der Spalte B2 in Tabellenblatt 1 "Blue" stehen. Vorher sind die Zellen natürlich leer.

 

Hi Achim,

vielen Dank!! Kann man das auch auf andere Arbeitsblätter ausweiten, d.h. wenn die Suchkriterien in einem 2. Arbeitsblatt sind?

Liebe Grüße

 

Hallo,

teste mal:

Option Explicit

Public Sub MatchProperties()

Dim objInputSheet As Worksheet, objOutputSheet As Worksheet
Dim objCell As Range
Dim lngRow As Long, lngColumn As Long
Dim strFirstAddress As String

Set objInputSheet = Worksheets("Tabelle1") 'Tabelle mit den Kriterien
Set objOutputSheet = Worksheets("Tabelle2") 'Tabelle mit den Texten

With objInputSheet

For lngColumn = 1 To 3

For lngRow = 2 To .Cells(.Rows.Count, lngColumn).End(xlUp).Row

Set objCell = objOutputSheet.Columns(1).Find( _
What:=.Cells(lngRow, lngColumn).Value, _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

If Not objCell Is Nothing Then

strFirstAddress = objCell.Address

Do

objCell.Offset(0, lngColumn).Value = .Cells(lngRow, lngColumn).Value

Set objCell = objOutputSheet.Columns(1).FindNext(After:=objCell)

Loop Until objCell.Address = strFirstAddress

Set objCell = Nothing

End If
Next
Next
End With

Set objInputSheet = Nothing
Set objOutputSheet = Nothing

End Sub

 

Ich habe hier mal so ein kleines Beispiel erstellt von den Inputs und was ich als Output erwarten würde..

Liebe Grüße
Eda

 

Vielen Dank Nepumuk!!! Ich teste das mal !!

Liebe Grüße

 

Hallo Eda,

das funktioniert noch nicht so richtig. Daher:

Option Explicit

Public Sub MatchProperties()

Dim objInputSheet As Worksheet, objOutputSheet As Worksheet
Dim objCell As Range
Dim objRegEx As Object
Dim lngRow As Long, lngColumn As Long
Dim strFirstAddress As String

Set objRegEx = CreateObject("VBScript.RegExp")

With objRegEx
.Global = True
.IgnoreCase = True
End With


Set objInputSheet = Worksheets("Suchkriterien ")
Set objOutputSheet = Worksheets("Artikelbeschreibungen ")

With objInputSheet

For lngColumn = 1 To 3

For lngRow = 2 To .Cells(.Rows.Count, lngColumn).End(xlUp).Row

Set objCell = objOutputSheet.Columns(1).Find( _
What:=.Cells(lngRow, lngColumn).Value, _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

If Not objCell Is Nothing Then

strFirstAddress = objCell.Address

objRegEx.Pattern = "b" & .Cells(lngRow, lngColumn).Value & "b"

Do

If objRegEx.Test(objCell.Value) Then _
objCell.Offset(0, lngColumn).Value = .Cells(lngRow, lngColumn).Value

Set objCell = objOutputSheet.Columns(1).FindNext(After:=objCell)

Loop Until objCell.Address = strFirstAddress

Set objCell = Nothing

End If
Next
Next
End With

Set objInputSheet = Nothing
Set objOutputSheet = Nothing
Set objRegEx = Nothing

End Sub

 

Fällt mir wieder das hier zu ein...

 

Eventuell auch.
Für ältere Versionen.

B2:B5
Code:

C2:C5
Code:

D2: D5
Code: