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, 21:08 (Dieser Beitrag wurde zuletzt bearbeitet: 01.01.2018, 21: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