die Ausgabe erfolgt in Spalte "SP"
Sub Kevin()
'Spalte der Ausgabe
SP = 5
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
Select Case Cells(i, 2)
Case "Boccia"
Cells(i, SP) = Mid(Cells(i, 1), InStrRev(Cells(i, 1), " "))
Case "Charriol"
Tx = Split(Cells(i, 1))
For ii = 0 To UBound(Tx)
If Tx(ii) Like "#######" Then
Cells(i, SP) = Tx(ii)
Exit For
End If
Next ii
Case "Engelsrufer"
a = InStr(1, Cells(i, 1), "ER-")
e = InStr(a + 1, Cells(i, 1), " ")
Cells(i, SP) = Mid(Cells(i, 1), a, e - a)
If InStr(1, Cells(i, SP), "PARA") = 0 Then Cells(i, SP) = Cells(i, SP) & "-M"
Case "JuwelmaLux"
Cells(i, SP) = Mid(Cells(i, 1), InStrRev(Cells(i, 1), " ") + 1)
Case "Modern Caps Design"
Cells(i, SP) = Mid(Cells(i, 1), InStr(1, Cells(i, 1), "MCD"), 13)
Case "s.Oliver"
a = InStr(1, Cells(i, 1), "SO")
e = InStr(a, Cells(i, 1), " ")
Cells(i, SP) = Mid(Cells(i, 1), a, e - a)
Case "VIVENTY"
Tx = Split(Cells(i, 1))
For ii = 0 To UBound(Tx)
If Tx(ii) Like "######" Then
Cells(i, SP) = Tx(ii)
Exit For
End If
Next ii
Case "Lotus"
a = InStr(1, Cells(i, 1), "LS")
e = InStr(a, Cells(i, 1), " ")
Cells(i, SP) = Mid(Cells(i, 1), a, e - a)
Case "POLICE"
a = InStr(1, Cells(i, 1), "PJ")
e = InStr(a, Cells(i, 1), " ")
Cells(i, SP) = Mid(Cells(i, 1), a, e - a)
Case "Nomination"
Tx = Split(Cells(i, 1))
For ii = 0 To UBound(Tx)
If Left(Tx(ii), 6) Like "######" Then
Cells(i, SP) = Tx(ii)
Exit For
End If
Next ii
End Select
Next i
End Sub
Ich mag die Branche der Luxuswaren nicht. |