Neue Spalte bei Zeilenende
22.08.2011 13:51:19
NoNet
Hallo Peter,
hier eine angepasste Variante : Falls die Anzahl möglicher Zeilen erreicht wurde, wird die Liste einfach mit 1 Leerspalte getrennt wieder oben fortgeführt. Allerdings ist eine Sortierung dann nicht mehr (bzw. nur in der ersten Ergebnisreihe) möglich :
Sub AuftragsKombisAuflisten()
Dim lngZ1 As Long, lngZ2 As Long, lngZ3 As Long
Dim lngZA As Long, lngZE As Long, lngZN As Long
Dim lngS As Long
Const lngEZ As Long = 4 'Zeile der ersten Kombination
lngS = 4 'Ab Spalte 4 eintragen
lngZN = lngEZ
lngZA = lngZN
For lngZ1 = lngEZ To Cells(Rows.Count, 1).End(xlUp).Row + 1
If Cells(lngZ1 - 1, 1) Cells(lngZ1, 1) And lngZ1 > lngZA Then 'Auftragswechsel
For lngZ2 = lngZA To lngZE - 1
For lngZ3 = lngZ2 + 1 To lngZE
Cells(lngZN, lngS) = Cells(lngZ2, 1)
Cells(lngZN, lngS + 1) = Cells(lngZ2, 2) & Cells(lngZ3, 2)
lngZN = lngZN + 1
If lngZN > Rows.Count Then 'Falls Anzahl Zeilen erreicht wurde
lngZN = lngEZ 'Zeilenzähler wieder auf Anfangszeile
lngS = lngS + 3 '3 Spalten weiter
End If
Next
Next
lngZA = lngZ1
Else
lngZE = lngZ1
End If
Next
'Sortieren (nur Spalten 4 und 5):
Range(Cells(lngEZ, 4), Cells(lngZN, 5)).Sort key1:=Cells(lngEZ, 4), key2:=Cells(lngEZ, 5), _
header:=xlNo
End Sub
Gruß, NoNet
Exceltreffen 28.-30.10.2011 in Chemnitz
Ein Treffen für alle Excel-Freunde und Besucher deutschsprachiger Excel-Foren.
Alle Infos - Programm - Anmeldung - Teilnehmerliste etc. gibt es auf
http://www.exceltreffen.de/index.php?page=211
Wir freuen uns auf euch...