Zählen und ausgeben von Werten.

[snb]

Code:

Sub M_snb()
   sn = Application.Transpose(Sheet1.Columns(Sheet1.Rows(1).Find("ID1").Column).SpecialCells(2))
   ReDim sp(UBound(sn) \ 81)
   
   For j = 2 To UBound(sn)
     sp((j - 1) \ 81) = sp((j - 1) \ 81) & "," & sn(j)
   Next
   
   For j = 0 To UBound(sp)
      Sheet1.Cells(81 * (j + 1) + 1, 7) = Mid(sp(j), 2)
   Next
End Sub

oder

Code:

Sub M_snb()
   sn = Sheet1.Columns(Sheet1.Rows(1).Find("ID1").Column).SpecialCells(2).Resize(, 3)
  
   For j = 2 To UBound(sn)
     y = 81 * (j \ 81 + 1) + 1
     If y > UBound(sn) Then y = UBound(sn)
     sn(y, 3) = sn(y, 3) & IIf(sn(y, 3) = "", "", ",") & sn(j, 1)
   Next
  
   Sheet1.Columns(Sheet1.Rows(1).Find("ID1").Column).SpecialCells(2).Offset(, 4).Resize(, 3) = sn
End Sub

[fredo]

Danke für all die vielen netten und qualitativ sehr guten Antworten.

@ shaunan: dein erster Beitrag hat die Qerte nicht in einer Zelle ausgegeben und auch nicht in der richtigen Zeile aber war auch sehr interessant zu sehen wie der Code arbeitet.

@Kuwer: genau so hatte ich mir das vorgestellt, ich bin gerade dabei den Code durchzugehen.
dazu ein Frage: cells.resize.value ist mir noch nicht ganz klar was der Befehl genau macht. Also offentsichtlich irgendwie die 81 Zellen in eine einzige schreiben. Aber was denkt sich Excel währendbei?

Den Rest schau ich mir die Tage noch an und versuch es zu verstehen und werde nochmal kommentieren.. danke euch!

[Kuwer]

Hallo Fredo,

cells.resize.value ist mir noch nicht ganz klar was der Befehl genau macht. Also offentsichtlich irgendwie die 81 Zellen in eine einzige schreiben. Aber was denkt sich Excel währendbei?

gehe mal mit dem Cursor auf Resize und drücke F1.
Dann kommt/sollte sowas kommen:

Range.Resize-Eigenschaft
Ändert die Größe des angegebenen Bereichs. Gibt ein Range-Objekt zurück, das den geänderten Bereich darstellt.
Syntax

Ausdruck.Resize(RowSize, ColumnSize)

Ausdruck   Ein Ausdruck, der ein Range-Objekt zurückgibt.


Was sich Excel währenddessen dabei denkt, weiß ich nicht.  :22:

Gruß Uwe