Option Explicit
Sub aehnliche_artikel()
Dim sku_array(1 To 50) As String, pos As Integer, sku_list As String
Dim aa_a As String, aa_b As String, equal As Boolean
Dim i As Integer, k As Integer, m As Integer, row_count As Integer
Dim i_col As Integer, sku_col As Integer, aa_col As Integer
With ThisWorkbook.Worksheets("Tabelle1")
For i_col = 1 To 256
Select Case .Cells(1, i_col).Value
Case "stock_model"
sku_col = i_col
Case "free_aehnliche_artikel"
aa_col = i_col
Exit For
End Select
Next i_col
End With
row_count = 12000
Erase sku_array
sku_list = ""
pos = 1
With ThisWorkbook.Worksheets("Tabelle1")
.Columns(aa_col + 1).Insert
.Columns(aa_col + 1).Select
Selection.NumberFormat = "@"
.Cells(1, aa_col + 1).Value = row_count
For i = 2 To row_count
aa_a = .Cells(i, aa_col).Value
For k = 2 To row_count
aa_b = .Cells(k, aa_col).Value
If i <> k And aa_a = aa_b And aa_a <> "" Then equal = True Else equal = False
If equal = True Then
sku_array(pos) = .Cells(k, sku_col).Value
pos = pos + 1
End If
Next k
sku_list = sku_array(1)
For m = 2 To pos - 1
sku_list = sku_list & ";" & sku_array(m)
Next m
sku_list = sku_list & sku_array(pos)
.Cells(i, aa_col + 1).Value = sku_list
Erase sku_array
sku_list = ""
pos = 1
Next i
End With
End Sub