Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1520to1524
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

Code kürzen

Code kürzen
09.11.2016 15:10:53
Berndt
Hallo zusammen,
ich frage mich ob man nicht die folgenden 2 Codestellen kürzen kann, der Übersicht halber.
...
Zell.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlDot
Zell.Offset(0, 2).Borders(xlEdgeBottom).TintAndShade = 0
Zell.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin
Zell.Offset(0, 2).Locked = False
Zell.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlDot
Zell.Offset(0, 3).Borders(xlEdgeBottom).TintAndShade = 0
Zell.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin
Zell.Offset(0, 3).Locked = False
Zell.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlDot
Zell.Offset(0, 4).Borders(xlEdgeBottom).TintAndShade = 0
Zell.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin
Zell.Offset(0, 4).Locked = False
Zell.Offset(0, 5).Borders(xlEdgeBottom).LineStyle = xlDot
Zell.Offset(0, 5).Borders(xlEdgeBottom).TintAndShade = 0
Zell.Offset(0, 5).Borders(xlEdgeBottom).Weight = xlThin
Zell.Offset(0, 5).Locked = False
Zell.Offset(0, 6).Borders(xlEdgeBottom).LineStyle = xlDot
Zell.Offset(0, 6).Borders(xlEdgeBottom).TintAndShade = 0
Zell.Offset(0, 6).Borders(xlEdgeBottom).Weight = xlThin
Zell.Offset(0, 6).Locked = False
...
und
Private Sub ToggleButton1_Click()
ActiveWorkbook.Worksheets("Themenspeicher").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Themenspeicher").Sort.SortFields.Add Key:=Range( _
"E6:E24"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Themenspeicher").Sort.SortFields.Add Key:=Range( _
"B6:B24"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Themenspeicher").Sort.SortFields.Add Key:=Range( _
"D6:D24"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Themenspeicher").Sort
.SetRange Range("B5:F24")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Das letzte Sub ist mit einem Rekorder aufgenommen und Prinzipiell hätte ich gerne die Begrenzung nach unten flexibel gelassen (Also nicht bis F24). Geht das?
VG Berndt

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code kürzen
09.11.2016 16:14:47
Michael
Hi,
das könnte dann so aussehen:
Sub t1()
Dim Zell As Range
Set Zell = Range("B2")
With Zell.Offset(0, 2).Resize(, 5)
With .Borders(xlEdgeBottom)
.LineStyle = xlDot
.TintAndShade = 0
.Weight = xlThin
End With
.Locked = False
End With
End Sub
Sub sortieren(sh As Worksheet, von As Long, bis As Long)
sh.Range("B" & von & ":F" & bis).Sort key1:=sh.Range("E" & von), order1:=xlAscending, _
key2:=sh.Range("B" & von), order2:=xlAscending, _
key3:=sh.Range("D" & von), order3:=xlAscending, _
Header:=xlYes
End Sub
Private Sub ToggleButton1_Click()
Dim von&, bis& ' oberste bzw. unterste Zeile as long
von = 6
bis = 24  ' oder eben irgendwie ermitteln
Call sortieren(ActiveSheet, von, bis)
' Bei Dir dann so:
'Call sortieren(Worksheets("Themenspeicher"), von, bis)
End Sub

Das Sortieren habe ich ausgelagert, dann schreibt es sich schöner bzw. ist flexibler.
Wie Du die untere Zeile ermittelst, wurde wahrscheinlich ausreichend in den vorhergehenden Threads erörtert...
Schöne Grüße,
Michael
Anzeige
AW: Code kürzen
09.11.2016 16:35:54
Berndt
Danke für die Antwort.
Der erste Teil mit dem Formatieren funktioniert.
Der letzte Teil
Sub sortieren(sh As Worksheet, von As Long, bis As Long)
sh.Range("B" & von & ":F" & bis).Sort key1:=sh.Range("E" & von), order1:=xlAscending, _
key2:=sh.Range("B" & von), order2:=xlAscending, _
key3:=sh.Range("D" & von), order3:=xlAscending, _
Header:=xlYes
End Sub
Private Sub ToggleButton1_Click()
Dim von&, bis& ' oberste bzw. unterste Zeile as long
von = 6
bis = 24  ' oder eben irgendwie ermitteln
Call sortieren(ActiveSheet, von, bis)
' Bei Dir dann so:
'Call sortieren(Worksheets("Themenspeicher"), von, bis)
End Sub
funktioniert allerdings nur einmalig.
Möchte ich dann z.B. das am nähesten gelegene Datum umschreiben, damit es das am weitesten entfernt wird, funktioniert das Makro nicht mehr (es passiert nix)
VG
Anzeige
AW: Code kürzen
09.11.2016 20:03:13
Michael
Hi,
a) hast Du auch den auskommentierten Teil verwendet? Ich hatte für meine Tests das activesheet genommen, weil ich nicht groß neue Blätter anlegen wollte.
b) kapiere ich nicht ganz: vielleicht ist ne Beispieldatei doch sinnvoll.
Schöne Grüße,
Michael
AW: Code kürzen
09.11.2016 21:29:27
Gerd
Hallo Berndt!
Sub eins()
Dim Zell As Range, Bereich As Range
Set Zell = Range("A5") 'Anpassen
Set Bereich = Zell.Offset(0, 2).Resize(1, 5)
With Bereich.Borders(xlEdgeBottom)
.LineStyle = xlDot
.TintAndShade = 0
.Weight = xlThin
End With
Bereich.Locked = True
End Sub
Gruß Gerd
Anzeige
AW: Code flexibel nach unten
09.11.2016 21:52:27
Gerd
Hallo Berndt!
Private Sub ToggleButton1_Click()
Dim Ws As Worksheet, lngLZ As Long
Set Ws = ActiveWorkbook.Worksheets("Themenspeicher")
LZ = Ws.Cells(Ws.Rows.Count, 5).End(xlUp).Row
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Ws.Range( _
"E6:E" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Ws.Sort.SortFields.Add Key:=Ws.Range( _
"B6:B" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Ws.Sort.SortFields.Add Key:=Ws.Range( _
"D6:D" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Ws.Sort
.SetRange Ws.Range("B5:F" & LZ)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Gruß Gerd
Anzeige
Vielen Dank, dennoch Fehler ?
10.11.2016 09:10:42
Berndt
Vielen Vielen Dank für den Code, angepasst auf mein Bsp. ist er ja eig. auch schon, dennoch kommt folgender Fehler beim abspielen:
"Fehler beim kompilieren: Unzulässige Verwendung einer Eigenschaft"
Der Fehler taucht an der fett markierten Stelle.
Bin leicht verwirrt^^
Private Sub ToggleButton1_Click()
Dim Ws As Worksheet, lngLZ As Long
Set Ws = ActiveWorkbook.Worksheets("Themenspeicher")
LZ = Ws.Cells(Ws.Rows.Count, 5).End(xlUp).Row
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Ws.Range( _
"E6:E" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Ws.Sort.SortFields.Add Key:=Ws.Range( _
"B6:B" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Ws.Sort.SortFields.Add Key:=Ws.Range( _
"D6:D" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Ws.Sort
.SetRange Ws.Range("B5:F" & LZ)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
VG Berndt
Anzeige
AW: Vielen Dank, dennoch Fehler ?
11.11.2016 08:56:26
Berndt
ich lass mal noch offen, sorry vergessen
AW: Vielen Dank, dennoch Fehler ?
11.11.2016 09:06:51
Berndt
Habs.
Private Sub ToggleButton1_Click()
Dim Ws As Worksheet
Dim lngLZ As Long
Set Ws = ActiveWorkbook.Worksheets("Themenspeicher")
LZ = Ws.Cells(Ws.Rows.Count, 5).End(xlUp).Row
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range( _
"E6:E" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Ws.Sort.SortFields.Add Key:=Range( _
"B6:B" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Ws.Sort.SortFields.Add Key:=Range( _
"D6:D" & LZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With Ws.Sort
.SetRange Range("B5:F" & LZ)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Anzeige
Danke
10.11.2016 09:17:35
Berndt
Danke dafür.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige