Werte in Spalte suchen und in Spalten daneben eintragen

[Kuwer]

Hallo Oliver,

das hier dauert in Deiner Beispieldatei nur 24 Minuten:

Code:

Sub Test()
  Dim i As Long, j As Long, k As Long
  Dim varL As Variant, varT As Variant
  
  varT = Worksheets("Stellentitel").Range("A1").CurrentRegion.Value
  varL = Worksheets("Suchstrings").Range("A1").CurrentRegion.Value
  ReDim Preserve varT(1 To UBound(varT), 1 To 999)
  
  For i = 2 To UBound(varT)
    For j = 2 To UBound(varL)
      If InStr(1, varT(i, 1), varL(j, 1), 1) Then
        For k = 2 To UBound(varT, 2)
          If varT(i, k) = "" Then Exit For
        Next k
        varT(i, k) = varL(j, 1)
      End If
    Next j
  Next i
  
  Worksheets("Stellentitel").Range("A1").CurrentRegion.Resize(, 999).Value = varT
End Sub

Gruß Uwe

[obux]

Hallo Klaus-Dieter,

wow super. Laufzeit ist eigentlich nicht so wichtig. Einmal die Woche sollte locker reichen und dann kann es auch über Nacht laufen.


Grüße und Danke
Oliver

---

Hallo Uwe,

ich hab mich so über die Antwort von Klaus-Dieter gereut, dass ich Deine gar nicht gesehen habe. Das probiere ich heute gleich aus.


Grüße und Danke
Oliver

[obux]

Hallo,

das hat super geklappt! Genau, was ich wollte. Eine Sache noch, geht das auch in Case Sensitive, die "normale Suche" kann das ja, ist das hier auch möglich?


Grüße & vielen Dank
Oliver

[Kuwer]

Hallo Oliver,,

mit Parameter 0 ist es Case Sensitive:

If InStr(1, varT(i, 1), varL(j, 1), 0) Then

Gruß Uwe

[obux]

Hallo Uwe,

krass - Danke vielmals! Hast Du einen Paypal Account oder ein Patreon oder sowas?


Grüße
Oliver

[Kuwer]

Hallo Oliver,

hab ich, aber verrate ihn nicht.
Du darfst Dich aber gerne hier ganz unten bei Spenden erkenntlich zeigen.

Gruß Uwe

[Janush]

Ein sehr schöner Code von Kuwer. Ich wollte eigentlich auch noch was beitragen, aber dagegen kommt nichts an...was die Laufzeit angeht