Sortieren nach

Forumthread: Sortieren nach

Sortieren nach

07.07.2005 12:25:20

Andreas

Hallo an alle
Ich bräuchte mal Eure Hilfe
ich möchte in meiner Tabelle die farblich gekennzeichneten" Blöcke" nach den roten KW- Nummern ordnen und zwar so, dass immer der älteste Block (KW mäßig)
unten steht. Ist das eventuell machbar...
Und was noch wichtiger ist - könnte mir jemand von Euch dabei helfen ?
Für eine Antwort wäre ich dankbar....
schönen Tag noch
Andreas
https://www.herber.de/bbs/user/24529.xls

5
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

AW: Sortieren nach

07.07.2005 15:13:55

Reinhard

Hallo Andreas,
noch irgendwas an meinem Code ist faul, muss jetzt leider mal weg. Vielleicht siehst du oder jmd hier wodrans noch hängt. Wenn nicht schau ich später nochmal danach.
Gruß
Reinhard


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

AW: Sortieren nach

07.07.2005 15:34:51

Andreas

Hallo
schönen Dank für die Antwort - aber ob ich mit meinem Wissen da durchsteige, weiss
ich noch nicht - ich versuche es aber.
Es wäre echt nett, wenn Du nochmal danach schauen könntest...
Ich danke dir trotzdem.
bis später
Andreas

Frage noch offen

07.07.2005 16:40:04

Reinhard

Hi, habe im Moment keine Zeit dafür, wenn nicht gelöst löse ich das später.
Gruß
Reinhard

Lösung

07.07.2005 19:24:12

Reinhard

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

AW: Lösung

08.07.2005 11:57:15

Andreas

hallo Reinhard
Danke nochmals für die Mühe, leider hab ich erst heute danach sehen können.
Am Wocheende probiere ich es aus - hab die Datei zuhause gelassen....
schönes Wochenende
Andreas

Beliebteste Forumthreads (12 Monate)

Forumthread: Sortieren nach

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread