Sortieren nach

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Sortieren nach

07.07.2005 15:13:55

Reinhard

AW: Sortieren nach

07.07.2005 15:34:51

Andreas

Frage noch offen

07.07.2005 16:40:04

Reinhard

Lösung

07.07.2005 19:24:12

Reinhard

AW: Lösung

08.07.2005 11:57:15

Andreas

Sub tt() 'Worksheets("kurz").Delete anz = Int(ActiveSheet.UsedRange.Rows.Count / 28) ReDim block(anz) For n = 3 To anz * 28 Step 28 block(Int(n / 28 + 1)) = Mid(Cells(n, 1), 3) Next n Worksheets.Add 'mir ist grad entfallen wie man ein Array sortiert *g, deshalb so For n = 1 To anz Cells(n, 1) = n Cells(n, 2) = block(n) Next n Range("A1:B" & anz).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom With Worksheets("Mengenmeldung NHA") .Cells.Copy ActiveSheet.Name = "kurz" Worksheets.Add ActiveSheet.Paste For n = 1 To anz For nn = 0 To 27 'MsgBox 3 + (n - 1) * 28 + nn 'MsgBox Worksheets("kurz").Cells(n, 2) + nn Rows(3 + (n - 1) * 28 + nn) = .Rows(Worksheets("kurz").Cells(n, 2) + nn) Next nn Next n '.Delete End With 'ActiveSheet.Name = "Mengenmeldung NHA" End Sub

Hallo Andreas,
du hast noch in E14 usw verbundene zellen, du erkennst sie leicht nach Durchlauf des makros.
Gruß
Reinhard

Sub tt()
anz = Int(Worksheets("Mengenmeldung NHA").UsedRange.Rows.Count / 28)
ReDim block(anz, 2)
For n = 3 To anz * 28 Step 28
block(Int(n / 28 + 1), 1) = Mid(Worksheets("Mengenmeldung NHA").Cells(n, 1), 3)
block(Int(n / 28 + 1), 2) = n
Next n
Worksheets.Add 'mir ist grad entfallen wie man ein Array sortiert *g, deshalb so
ActiveSheet.Name = "kurz"
With Worksheets("kurz")
For n = 1 To anz
.Cells(n, 1) = n
.Cells(n, 2) = block(n, 1)
.Cells(n, 3) = block(n, 2)
'MsgBox block(n)
Next n
.Range("A1:C" & anz).Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
With Worksheets("Mengenmeldung NHA")
.Cells.Copy
Worksheets.Add
ActiveSheet.Paste
For n = 1 To anz
For nn = 0 To 27
'MsgBox 3 + (n - 1) * 28 + nn
'MsgBox Worksheets("kurz").Cells(n, 3) + nn
.Rows(Worksheets("kurz").Cells(n, 3) + nn).Copy Destination:=ActiveSheet.Rows(3 + (n - 1) * 28 + nn)
Next nn
Next n
Application.DisplayAlerts = False
.Delete
End With
ActiveSheet.Name = "Mengenmeldung NHA"
Worksheets("kurz").Delete
Application.DisplayAlerts = True
End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread