Excel VBA Sortierproblem

[sharky51]

Hallo zusammen,

Ihr seid einfach genial. Super gut.

Vielen Dank Euch allen!

[sharky51]

1. Ich persönlich mag die Sortiermethode ab 2007 nicht und verwende lieber eine Zeile nachvollziehbaren Code als die acht, die uns der Makrorekorder aufdrängt (zumindest, wenn es sich um eine "normale" Sortierung handelt).
   
2. Ich nehme eine Hilfsspalte, die auf jeden Fall leer ist und lösche sie nach der Sortierung gleich wieder.
   
3. Normalerweise nehme ich auch die .FormulaR1C1-Variante, weil es auch diejenige ist, die Excel intern verwendet. Hier mal ausnahmsweise die .FormulaLocal-Version, damit der TE sieht, dass das Makro nichts anderes macht wie meine oben gepostete Formellösung.
   

Hallo Ralf,

mein Sortierproblem hat sich leider etwas verschäft und vielleicht hast Du noch ne Idee wie man auch dieses lösen könnte.

Vorab die Bemerkung dass ich wohl weiß dass Leerzeilen ein "no go" sind. Trotzdem möchte ich fragen ob folgende Aufgabe per VBA zu lösen ist und ob man die Leerzeile doch belassen kann.

Was möchte ich tun?
In Anlehnung an Deine oben gezeigte Sortiermethode, die ich cool finde, würde ich gerne wieder nach aufsteigendem Datum sortieren ....aber nur innerhalb eines jeden Datenblockes einer Kategorie, der Datenblock sollte getrennt sein durch die Leerzeile.... d.h. die Leerzeile sollte zwischen den Datenblöcken erhalten bleiben!

Hättest Du hierzu einen Lösungsansatz für mich?


Tabelle11

	G	H
1	Name	Kategorie
2	'Auswertung'!November_2014_Monatssumme	F
3	'Auswertung'!Oktober_2014_Monatssumme	F
4	'Auswertung'!April_2015_Monatssumme	F
5	'Auswertung'!August_2015_Monatssumme	F
6	'Auswertung'!Januar_2015_Monatssumme	F
7	'Auswertung'!Juli_2015_Monatssumme	F
8	'Auswertung'!Juni_2015_Monatssumme	F
9
10	'Auswertung'!November_2014_Monatssumme	A
11	'Auswertung'!Oktober_2014_Monatssumme	A
12	'Auswertung'!April_2015_Monatssumme	A
13	'Auswertung'!August_2015_Monatssumme	A
14	'Auswertung'!Januar_2015_Monatssumme	A
15	'Auswertung'!Juli_2015_Monatssumme	A
16	'Auswertung'!Juni_2015_Monatssumme	A
17
18	'Auswertung'!Januar_2015_Monatssumme	B
19	'Auswertung'!Juli_2015_Monatssumme	B
20	'Auswertung'!Juni_2015_Monatssumme	B
21	'Auswertung'!Mai_2015_Monatssumme	B
22	………	B
23	………	B

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 21.01 einschl. 64 Bit

Vielen Dank!

[RPP63]

Hallo Erich!
Ich habe keinen Ansatz, sondern eine Lösung. :19:
Leerzeilen sind Mist, aber man kann sie ja überlisten.
Ist vielleicht nicht so leicht zu verstehen wie mein erstes Makro, aber Du kannst ja zur Not nachfragen ...

Modul Modul1

Option Explicit 
 
Sub SortSpezRPP() 
Dim Zeile() As Long, cnt As Long, i As Long 
Dim Spalte As Integer 
Spalte = Cells(1, Columns.Count).End(xlToLeft).Column + 1 
Redim Zeile(0) 
Zeile(0) = 2 
cnt = 1 
i = 1 
Application.ScreenUpdating = False 
With ActiveSheet 
   Do Until cnt = 2 ^ 20 
      Redim Preserve Zeile(i) 
      cnt = .Cells(cnt, 1).End(xlDown).Row 
      If cnt < 2 ^ 20 Then Zeile(i) = cnt 
      i = i + 1 
   Loop 
   cnt = 0 
   For cnt = 0 To Ubound(Zeile) - 2 Step 2 
      Range(.Cells(Zeile(cnt), Spalte), .Cells(Zeile(cnt + 1), Spalte)).FormulaR1C1 = _
           "=--(MID(RC1,FIND(""!"",RC1)+1,3)&MID(RC1,FIND(""_"",RC1)+3,2))" 
      .Range(.Cells(Zeile(cnt), 1), .Cells(Zeile(cnt + 1), Spalte)).Sort _
         Key1:=.Cells(Zeile(cnt), Spalte), Order1:=xlAscending, Header:=xlNo 
   Next 
   .Columns(Spalte).Delete 
End With 
End Sub 

Gruß Ralf

[RPP63]

Jetzt erst gesehen ...
Deine Strings stehen ja in Spalte G.
Da ich nicht weiß, ob Du mein Makro problemlos anpassen kannst, habe ich das mal für Dich getan.
Modul Modul1

Option Explicit 
 
Sub SortSpezRPP() 
Dim Zeile() As Long, cnt As Long, i As Long 
Dim Spalte As Integer 
Spalte = Cells(1, Columns.Count).End(xlToLeft).Column + 1 
Redim Zeile(0) 
Zeile(0) = 2 
cnt = 1 
i = 1 
Application.ScreenUpdating = False 
With ActiveSheet 
   Do Until cnt = 2 ^ 20 
      Redim Preserve Zeile(i) 
      cnt = .Cells(cnt, 7).End(xlDown).Row 
      If cnt < 2 ^ 20 Then Zeile(i) = cnt 
      i = i + 1 
   Loop 
   cnt = 0 
   For cnt = 0 To Ubound(Zeile) - 2 Step 2 
      Range(.Cells(Zeile(cnt), Spalte), .Cells(Zeile(cnt + 1), Spalte)).FormulaR1C1 = _
           "=--(MID(RC7,FIND(""!"",RC7)+1,3)&MID(RC7,FIND(""_"",RC7)+3,2))" 
      .Range(.Cells(Zeile(cnt), 1), .Cells(Zeile(cnt + 1), Spalte)).Sort _
         Key1:=.Cells(Zeile(cnt), Spalte), Order1:=xlAscending, Header:=xlNo 
   Next 
   .Columns(Spalte).Delete 
End With 
End Sub 

Gruß Ralf

[sharky51]

Ich habe keinen Ansatz, sondern eine Lösung. :19:
Leerzeilen sind Mist, aber man kann sie ja überlisten.
Ist vielleicht nicht so leicht zu verstehen wie mein erstes Makro, aber Du kannst ja zur Not nachfragen ...

Hallo Ralf,

es ist vermessen immer nach einer Lösung zu fragen, wenn es dann doch eine gibt um so besser
Es ist schon klasse welche Hilfe man hier bekommt, super gut. Du bist klasse, vielen Dank!

Dein Makro funktioniert super und bevor ich frage warum das so ist werde ich es mir ganz genau ansehen und versuchen es zu verstehen.

Ich wünsche noch ein schönes WE!

[snb]

Wenn die Daten in Spalte A:

Code:

Sub M_snb()
  For Each ar In Sheet1.Columns(1).SpecialCells(2).Areas
    For Each it In ar
      it.Offset(, 1) = Application.Match(Split(Split(it, "!")(1), "_")(0), Application.GetCustomListContents(4), 0)
    Next

    ar.Resize(, 2).Sort ar.Cells(1).Offset(, 1)
  Next

  Sheet1.columns(2).clearcontents
End Sub

Wenn die Jahren auch sortiert werden müssen:

Code:

Sub M_snb()
  For Each it In Sheet1.Columns(1).SpecialCells(2)
    If it <> "" Then it.Offset(, 1) = Split(it, "_")(1) & Format(Application.Match(Split(Split(it, "!")(1), "_")(0), Application.GetCustomListContents(4), 0), "00")
  Next

  Sheet1.UsedRange.Sort Sheet1.Cells(1, 2)
  Sheet1.columns(2).clearcontents
End Sub