Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Sortieren-Makro erweitern

Sortieren-Makro erweitern
30.07.2008 14:44:24
mike49
Hallo zusammen,
ich habe ein Sortieren-Makro, das auch funktioniert.
Ich wollte jetzt den Sortierbereich um 2 Zeilen erweitern und habe im Makro die Zahl 145 durch 147 ersetzt. Aber das funktioniert nicht, denn ein Eintrag in Zeile 147 wird nicht einfach einsortiert, sondern wieder gelöscht. Was habe ich falsch gemacht?

Sub Sortieren1()
'Variablendimensionierung
Dim i As Long, j As Long
Dim ws As Worksheet
'Variableninitialisierung
j = 1
'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'Tabellenblatt wird hinzugefügt
Set ws = Worksheets.Add
ws.Visible = xlVeryHidden
'Kopieren der ungeraden Zellbereiche (Spalte A und D bis AD)
'zwischen Zeile 13 und Zeile 145 auf das neue Tabellenblatt
For i = 13 To 145
If i Mod 2 = 1 Then
With ActiveSheet
.Cells(i, "A").Copy _
Destination:=ws.Cells(j, "A")
.Range(.Cells(i, "C"), .Cells(i, "AA")).Copy _
Destination:=ws.Cells(j, "B")
j = j + 1
End With
End If
Next
With ws
'Nach doppelten Einträgen überprüfen und Inhalte löschen!
For i = 1 To 67
If Application.WorksheetFunction.CountIf(.Range("J18:J" & i), .Cells(i, "J")) > 1 Then
.Range("J" & i & ":Z" & i).ClearContents
End If
Next
'Spalten des neuen Tabellenblattes sortieren
.[A1:Z67].Sort Key1:=ws.[J1], Order1:=xlAscending, _
Key2:=ws.[I1], Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
End With
'Bereiche auf dem aktiven Blatt löschen
With ActiveSheet
.[A13:A145].ClearContents
.[C13:AA145].ClearContents
End With
'Die Variable wird neu initialisiert!
j = 13
For i = 1 To 67
With ws
'Ist kein Liedtitel vorhanden, wird der Inhalt der ganzen Zeile gelöscht
If .Cells(i, "J") = "" Then
Range(.Cells(i, "A"), .Cells(i, "AA")).ClearContents
End If
'Zeilen vom hinzugefügten Tabellenblatt wieder zurückkopieren
.Cells(i, "A").Copy _
Destination:=ActiveSheet.Cells(j, "A")
.Range("B" & i & ":" & "AB" & i).Copy _
Destination:=ActiveSheet.Cells(j, "C")
j = j + 2
End With
Next
'Fehlermeldung ausschalten
Application.DisplayAlerts = False
'Hinzugefügtes Tabellenblatt wird wieder sichtbar und dann gelöscht
With ws
.Visible = True
.Delete
End With
[A1].Select
'Fehlermeldung wieder einschalten
Application.DisplayAlerts = True
End Sub


Gruß mike49

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sortieren-Makro erweitern
30.07.2008 15:14:02
mpb
Hallo,
ohne den Code näher zu prüfen: Du überträgst doch auch eine Zeile mehr, nämlich die 147. Also musst Du überall 145 durch 147 und 67 durch 68 ersetzen.
Gruß
Martin

Danke. Es funktioniert . . .
30.07.2008 15:21:00
mike49
wusste nicht, dass ich auch noch 67 durch 68 ersetzen muss.
Gruß
mike49
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige