Office: Makro erweitern...

Hallo,

habe mal wieder ein Problem, dass ich nicht lösen kann.
Ist wahrscheinlich eine Kleinigkeit...aber mit Makro-Programmierung kenne ich mich leider nicht so aus


Das Makro kopiert das angezeigte Tabellenblatt komplett in das Tabellenblatt "pdf" und sortiert die Zellen A11:J34.

Nun möchte ich das Makro so erweitern, dass auch die Zellen A163:K186 sortiert werden.

Leider kann ich die Datei hier nicht posten, da sie zu groß ist.

Wer weiß Rat bzw. kann die gesuchte Ergänzung einfügen...?

Vielen Dank schon einmal
tobi :D


Sub tipps_sortieren()
'
' tipps_sortieren Makro
'
' Tastenkombination: Strg+c
'
Cells.Select
Selection.Copy
Range("A3").Select
Sheets("pdf").Select
Cells.Select
ActiveSheet.Paste
Range("A11:J34").Select
Selection.Interior.ColorIndex = xlNone
Range("A11:Z34").Select
Selection.Sort Key1:=Range("A11"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Dim i As Integer
Dim rng As Range
Dim ze As Long
For ze = 12 To 34 Step 2
If rng Is Nothing Then
Set rng = Range(Cells(ze, 1), Cells(ze, 10))
Else
Set rng = Union(rng, Range(Cells(ze, 1), Cells(ze, 10)))
End If
Next 'ze
rng.Select
Range("A12").Activate
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Range("A3").Select
End Sub

 

Hi Tobi,

ich nehme an, die Zeilen 163 bis 186 sollen nach dem Sortieren ebenfalls abwechselnd gelb gefärbt werden? Versuche es mal mit diesem Code:

Code:

Sub Sortieren()
   Dim wksTab As Worksheet
   Dim ze As Long
   For Each wksTab In Worksheets
      If wksTab.Name = "pdf" Then
         Application.DisplayAlerts = False
         wksTab.Delete
         Application.DisplayAlerts = True
         Exit For
      End If
   Next wksTab
   Worksheets("Tabelle1").Copy after:=Worksheets(Worksheets.Count)
   With Worksheets(Worksheets.Count)
      .Name = "pdf"
      .Range("A11:Z34").Sort Key1:=.Range("A11"), Order1:=xlAscending, Header:=xlGuess, _
         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
      For ze = 11 To 34
         If ze Mod 2 <> 0 Then
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.ColorIndex = xlNone
         Else
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.ColorIndex = 36
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.Pattern = xlSolid
         End If
      Next ze
      .Range("A163:K186").Sort Key1:=.Range("A163"), Order1:=xlAscending, Header:=xlGuess, _
         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
      For ze = 163 To 186
         If ze Mod 2 <> 0 Then
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.ColorIndex = xlNone
         Else
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.ColorIndex = 36
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.Pattern = xlSolid
         End If
      Next ze
   End With
End Sub

Bis später,
Karin

 

Hallo Karin,

erst mal vielen Dank für Deine Hilfe.

Leider bekomme ich bei Deiner Lösung folgenden Laufzeitfehler:

Worksheets("Tabelle1").Copy after:=Worksheets(Worksheets.Count)

Vielleicht noch der Hinweis, dass die Datei mehrere Tabellenblätter besitzt und das "ursprüngliche" Makro bei allen
Blättern funktioniert...

tobi

 

Noch eine kurze Ergänzung
Mein "ursprüngliches" Makro macht bereits alles was es soll, inklusive kopieren der Farbvorlagen, also
das Einfärben. Es geht mir nur noch um die Sortierung des angegebenen Zellbereiches

 

Hallo Karin,

habe Deine Lösung jetzt noch mal genauer getestet.
Das Problem liegt wohl damit zusammen, dass Dein Makro das Tabellenblatt "pdf" löscht...und dann kommt's zum Fehler.

Mein Makro hingegen kopiert das angezeigte Tabellenblatt in das Tabellenblatt "pdf" hinein und sortiert dann die Zellen A11:J34.
Die gesuchte Erweiterung soll dann eigentlich nur noch die Zellen A163:K186 sortieren.

Die Kopierfunktion meines Makros macht genau was sie soll...

tobi

 

Hi Tobi,

heißt das Tabellenblatt, welches kopiert werden soll vielleicht nicht "Tabelle1"?

In VBA kann zu 99% aller Fälle auf Select und Activate verzichtet werden - dein Code ist gespickt mit diesen unnötigen Befehlen, die die Performance wesentlich beeinträchtigen.

Bis später,
Karin

 

Hallo Karin,

das mag schon sein...das Makro ist auch nicht von mir, da ich wie bereits erwähnt da leider kein Experte imn Sachen Makros bin

In der Datei befinden sich mehrere Tabellenblätter mit den Namen 1. Spieltag, 2. Spieltag usw.

Das gerade angezeigte Tabellenblatt wird durch das Makro in das bestehende Tabellenblatt pdf hineinkopiert und wie bereits gesagt, ist mein Makro eigentlich
fast perfekt für meine Zwecke. Nur hat sich in unserer Spielaufstellung etwas geändert und der Zellbereich A163:K186 wird zwar auch mitkopiert (auch mit allen Farbformatierungen),
nur die Daten werden nicht sortiert...und dies soll die Erweiterung noch erledigen...:D

tobi

 

Hi Tobi,

ersetze die Zeile

Code:

Worksheets("Tabelle1").Copy after:=Worksheets(Worksheets.Count)

durch diese

Code:

ActiveSheet.Copy after:=Worksheets(Worksheets.Count)

dann wird nicht Tabelle1 sondern das gerade aktive Tabellenblatt kopiert.

Bis später,
Karin

 

Hallo Karin,

komme leider erst heute dazu mich wieder zu melden.

Also...Deine Änderung hat's gebracht.
Jetzt wird das Blatt kopiert und auch so sortiert wie ich es benötige.

Dafür erst mal vielen Dank.

Ich habe allerdings auch noch eine Frage. Das Einfärben der Zeilen ab 163 funktioniert auch...allerdings wird in der Spalte K
nich richtig eingefärbt...also von K163 bis K186.
Kann man das noch korrigieren...?:)

Danke...
tobi

 

PHP:

Hallo Karin,

den letzten "Wunsch" habe ich selber hinbekommen.
Ich glaube so langsam komme ich hinter die Mysterien der Makroprogrammierung;)

Danke für alles...
tobi

 

Hallo Zusammen,

nach gut einer Woche muss ich mich zum eigenen Thema noch einmal melden.
Das Makro von Karin funktioniert wie bereits beschrieben ja genau so wie es soll...allerdings habe ich nun nach einer
Woche einen kleinen Fehler bemerkt, der mir zuvor gar nicht aufgefallen ist.

Es wird im Bereich 163:186 erst ab Zeile 164 sortiert...obwohl doch im Makro .Range("A163:Z186").
steht...woran kann das liegen?

tobi

 

Hi Tobi,

wenn du den geposteten Code nicht kursiv formatierst sondern im erweiterten Antwort-Modus den Schalter mit der Raute # verwendest, dann wird der Code hier im Beitrag auch mit den Eintrückungen dargestellt und ist wesentlich besser lesbar (siehe mein Beitrag 25.08.2012, 08:27).

Den von dir genannten Fehelr kann ich nicht feststellen - in meinem nachgebauten Beispiel wird korrekt ab Zeile 163 sortiert.

Bis später,
Karin

 

Hallo Karin,

erst einmal Sorry für das schlechte Posten.

Ich habe die Datei mal soweit ausgedünnt, dass da nur noch ein Tabellenblatt enthalten ist.
Leider hat sie immer noch eine Größe von 344.000...also zu groß um als Anhang hier durchzukommen.

Bei mir wird definitiv nicht die Zeile 163 in die Sortierung eingeschlossen...

tobi

Code:

Sub tipps_sortieren()
'
'
' Tastenkombination: Strg+c
'
    Dim wksTab As Worksheet
   Dim ze As Long
   For Each wksTab In Worksheets
      If wksTab.Name = "pdf" Then
         Application.DisplayAlerts = False
         wksTab.Delete
         Application.DisplayAlerts = True
         Exit For
      End If
   Next wksTab
   ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
   With Worksheets(Worksheets.Count)
      .Name = "pdf"
      .Range("A11:Z34").Sort Key1:=.Range("A11"), Order1:=xlAscending, Header:=xlGuess, _
         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
      For ze = 11 To 34
         If ze Mod 2 <> 0 Then
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.ColorIndex = xlNone
         Else
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.ColorIndex = 36
            .Range(.Cells(ze, 1), .Cells(ze, 10)).Interior.Pattern = xlSolid
         End If
      Next ze
      .Range("A163:Z186").Sort Key1:=.Range("A163"), Order1:=xlAscending, Header:=xlGuess, _
         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
      For ze = 163 To 186
         If ze Mod 2 <> 0 Then
            .Range(.Cells(ze, 1), .Cells(ze, 11)).Interior.ColorIndex = xlNone
         Else
            .Range(.Cells(ze, 1), .Cells(ze, 11)).Interior.ColorIndex = 36
            .Range(.Cells(ze, 1), .Cells(ze, 11)).Interior.Pattern = xlSolid
         End If
      Next ze
   End With
End Sub
 

 

Hallo Karin...
ich habe den Fehler gefunden...für mich absolut unverständlich.

Die Blätter, die durch das Makro kopiert werden sollen sind bereits abwechselnd gefärbt.
Wenn man die Färbung entfernt...dann wird in der erstellten Kopie des Blattes auch richtig sortiert.

Das ist doch verrückt....

Dank' Dir...
tobi

 

Hallo Tobi,

wenn ich mal kurz etwas anmerken darf.
Ich vermute es liegt an "Header:=xlGuess".
Dadurch nimmt Excel an, dass der Bereich der sortiert werden soll Überschriften hat, und die sollen natürlich nicht mit sortiert werden.
Die Färbung ist bestimmt nicht die Ursache, höchstens der Auslöser, und verrückt ist es auch nicht.

Ändere den Befehl in "Header:=xlNo", belasse die Färbung wie sie ist, und schaue ob es dann funktioniert.


Ich hoffe geholfen zu haben.