Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
996to1000
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
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