Sub ReplaceFromList() Dim i As Long Dim lastRow As Long Dim varSearch As Variant Dim rng As Range Dim rngSearch As Range lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row Set rngSearch = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) Application.ScreenUpdating = False For i = 2 To lastRow varSearch = Range("A" & i) For Each rng In rngSearch If InStr(rng, varSearch) > 0 Then Range("C" & i) = rng.Value Exit For End If Next rng Next i Set rng = Nothing Set rngSearch = Nothing End Sub
Sub ReplaceFromList() 'Deklarieren der Variablen: 'Long für Zeilen 'Variant für Suchwort 'Range für Zelle und Zellbereiche Dim i As Long Dim lastRow As Long Dim varSearch As Variant Dim rng As Range Dim rngSearch As Range 'Ermitteln der letzten Zeile von Spalte A lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 'Definieren des Suchbereichs in Spalte B: von Zeile 2 bis letzte Zeile Spalte B Set rngSearch = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) 'Bildschirmflackern ausschalten Application.ScreenUpdating = False 'Die erste For-Next-Schleife durchsucht Spalte A nach dem 1. Suchwort, 'beginnend bei Zeile 2 For i = 2 To lastRow 'Das Suchwort in die Variable laden varSearch = Range("A" & i) 'Mit der 2. For-Next-Schleife wird jede Zelle in Spalte B (rngSearch) beginnend 'von Zeile 2 bis Ende Spalte B auf das Suchwort (varSearch) untersucht For Each rng In rngSearch 'Falls Suchwort gefunden ... If InStr(rng, varSearch) > 0 Then '... dann setze den Wert in Spalte C in die gleiche Zeile (i) wie das Suchwort ... Range("C" & i) = rng.Value '... und verlasse die innere Schleife ... Exit For 'Ende der If-Anweisung End If '(Ende innere Schleife) Next rng ' ... und erhöhe die Variable i um 1 'Dann gehe an den Anfang der ersten Schleife und lade 'das nächste Suchwort in die Variable Next i 'Die Range-Variablen zurücksetzen Set rng = Nothing Set rngSearch = Nothing End Sub
| 03.11.2023