Sub Main
on error resume next
for i = 2 to cells(rows.count,1).end(xlup).row
for j = 2 to 20
if cells(i,j) then c = c & ", " & cells(1,j)
next j
cells(i,22) = mid(c, 3)
c = ""
next i
End Sub
mfg
Folgende(r) 1 Nutzer sagt Danke an Fennek für diesen Beitrag:1 Nutzer sagt Danke an Fennek für diesen Beitrag 28 • merkurus
01.01.2018, 20:08 (Dieser Beitrag wurde zuletzt bearbeitet: 01.01.2018, 20:08 von Fennek.
Bearbeitungsgrund: Schleifenindex
)
Hallo,
dieser Ansatz ist etwas interessanter, aber nur an einem nachgemachten Beispiel getestet:
Code:
Sub Main
dim rr as range
for i = 2 to cells(rows.count, 1).end(xlup).row
set rr = rows(i).specialcells(2).offset(1-i)
for each r in rr
Tx = Tx & ", " & r
next r
cells(i,22) = mid(Tx, 3)
Tx = ""
next i
End Sub