Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
632to636
632to636
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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

Anzeige
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
Anzeige
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

Anzeige
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)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige