Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
23.04.2024 16:27:34
Excel Starthinweis - Arbeitsmappenleistung überprüfen ...
23.04.2024 16:15:16
Mittels VBA vordefinierte Kommentare in Zellen einfügen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1484to1488
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1484to1488
1484to1488
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA Makroänderung

VBA Makroänderung
06.04.2016 15:33:42
Bernd
Liebe Freunde des Excels,
ich habe eine bitte an Euch. Könnte mir jemand meinen Code, welchen ich mit dem Makrorecorder aufgezeichnet habe, etwas verfeinern bzw. verschönern und/oder kürzer machen? 
Sub Löschen()
' Löschen Makro
ActiveSheet.Unprotect
Range( _
"C4:V4,C9:V11,C13:V13,C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5:P8,R5:T8,V5:V8,C14:  _
_
D17,F14:H17,J14:L17,N14:P17,R14:T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26" _
).Select
Range("V23").Activate
ActiveWindow.SmallScroll Down:=24
Union(Range( _
"R32:T35,V32:V35,C42:D45,F42:H45,J42:L45,N42:P45,R42:T45,V42:V45,C4:V4,C9:V11,C13:V13,  _
_
C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5:P8,R5:T8,V5:V8,C14:D17,F14:H17,J14:L17,N14:P17,R14: _
T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26" _
), Range("C31:V31,C36:V38,C41:V41,C46:V48,C32:D35,F32:H35,J32:L35,N32:P35")). _
Select
Range("V42").Activate
ActiveWindow.SmallScroll Down:=21
Union(Range( _
"R32:T35,V32:V35,C42:D45,F42:H45,J42:L45,N42:P45,R42:T45,V42:V45,C50:V50,C55:V57,C59: _
V59,C64:V66,C68:V68,C73:V75,C60:D63,F60:H63,J60:L63,N60:P63,R60:T63,V60:V63,C69:D72,F69:H72,J69: _
L72,N69:P72,R69:T72,V69:V72,C51:D54,F51:H54,J51:L54,N51:P54,R51:T54,V51:V54" _
), Range( _
"C4:V4,C9:V11,C13:V13,C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5:P8,R5:T8,V5:V8,C14:  _
_
D17,F14:H17,J14:L17,N14:P17,R14:T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26,C31: _
V31,C36:V38,C41:V41,C46:V48,C32:D35,F32:H35,J32:L35,N32:P35" _
)).Select
Range("V51").Activate
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Selection.ClearContents
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 1
Range("C4:F4").Select
ActiveSheet.Protect
End Sub
Dieses Makro bezieht sich jedoch nur auf das aktive Tabellenblatt. Ich würde es aber gerne so lösen, dass ich nur eine Schaltfläche erstellen muss und mir das Makro meine gesamten Bereiche aller 12 Tabellenblätter löscht.
Meine Tabellenblätter habe ich nach den Monatsnamen betitelt, also Jänner, Februar, März usw. bis Dezember.
Der zu löschende Bereich (siehe mein aufgezeichnetes Makro) ist IMMER derselbe.
Hoffe dies ist auch ohne Beispielmappe für Euch lösbar, ansonsten werde ich morgen eine dementsprechend abgespeckte Version hochladen.
Danke vorab und nette Grüße,
Bernd

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Makroänderung
06.04.2016 16:37:05
Matthias
Hallo
Also verkürzt mal so:
Option Explicit
Sub bernd()
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Bereich3 As Range
Set Bereich1 = Range("C4:V4,C9:V11,C13:V13,C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5: _
P8,R5:T8,V5:V8,C14:D17,F14:H17,J14:L17,N14:P17,R14:T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26")
Set Bereich2 = Union(Range("R32:T35,V32:V35,C42:D45,F42:H45,J42:L45,N42:P45,R42:T45,V42:V45, _
C4:V4,C9:V11,C13:V13,C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5:P8,R5:T8,V5:V8,C14:D17,F14:H17,J14:L17,N14:P17,R14:T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26"), Range("C31:V31,C36:V38,C41:V41,C46:V48,C32:D35,F32:H35,J32:L35,N32:P35"))
Set Bereich3 = Union(Range("C50:V50,C55:V57,C59:V59,C64:V66,C68:V68,C73:V75,C60:D63,F60:H63,J60: _
L63,N60:P63,R60:T63,V60:V63,C69:D72,F69:H72,J69:L72,N69:P72,R69:T72,V69:V72,C51:D54,F51:H54,J51:L54,N51:P54,R51:T54,V51:V54"), Range("C4:V4,C9:V11,C13:V13,C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5:P8,R5:T8,V5:V8,C14:D17,F14:H17,J14:L17,N14:P17,R14:T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26,C31:V31,C36:V38,C41:V41,C46:V48,C32:D35,F32:H35,J32:L35,N32:P35"))
Union(Bereich1, Bereich2, Bereich3).ClearContents
End Sub
Allerdings müsstest Du die doppelten Bereich selbst entfernen
Denn dazu hatte ich keine Lust! ( wie z.B: "C4:V4" )
Sieht dann so aus:
Userbild
Einfach mit einer Schleife um Deine Monatsblätter starten.
Gruß Matthias

Anzeige
AW: VBA Makroänderung
06.04.2016 17:04:31
Bernd
Hallo,
Danke Dir für Deine Hilfe, aber auch bei einer "Schleife" komme ich nicht wirklich zurecht.
Eventuell hast Du ja noch weiter Lust oder es gibt ja noch wen anderen der mir Bitte Bitte weiter helfen könnte.
Es reicht mir ja ein Ansatz wie der Code aussehen müsste, damit ich ihn um meine 12 Blätter selbst erweitern könnte. Lieber wäre mir aber, gleich etwas fertiges zu bekommen, aber das ist halt nur Wunschdenken in Anbetracht dessen, dass hier alles umsonst von Dir bzw. Euch erledigt wird, dafür Daumen hoch!
Bin für Heute leider raus, sehe aber gleich morgen nach um bei einer Lösung meine Rückmeldung abgeben zu können.
Schönen Abend noch und lg,
Bernd

Anzeige
AW: VBA Makroänderung
06.04.2016 17:21:19
Matthias
Hallo
Wenn Du nur diese 12 Blätter in der Mappe hast gehts so:
Option Explicit
Sub bernd2()
Dim x&
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Bereich3 As Range
For x = 1 To Worksheets.Count
With Worksheets(x)
Set Bereich1 = .Range("C4:V4,C9:V11,C13:V13,C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5:P8, _
R5:T8,V5:V8,C14:D17,F14:H17,J14:L17,N14:P17,R14:T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26")
Set Bereich2 = Union(.Range("R32:T35,V32:V35,C42:D45,F42:H45,J42:L45,N42:P45,R42:T45,V42:V45, _
C4:V4,C9:V11,C13:V13,C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5:P8,R5:T8,V5:V8,C14:D17,F14:H17,J14:L17,N14:P17,R14:T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26"), .Range("C31:V31,C36:V38,C41:V41,C46:V48,C32:D35,F32:H35,J32:L35,N32:P35"))
Set Bereich3 = Union(.Range("C50:V50,C55:V57,C59:V59,C64:V66,C68:V68,C73:V75,C60:D63,F60:H63, _
J60:L63,N60:P63,R60:T63,V60:V63,C69:D72,F69:H72,J69:L72,N69:P72,R69:T72,V69:V72,C51:D54,F51:H54,J51:L54,N51:P54,R51:T54,V51:V54"), .Range("C4:V4,C9:V11,C13:V13,C18:V20,C22:V22,C27:V29,C5:D8,F5:H8,J5:L8,N5:P8,R5:T8,V5:V8,C14:D17,F14:H17,J14:L17,N14:P17,R14:T17,V14:V17,C23:D26,F23:H26,J23:L26,N23:P26,R23:T26,V23:V26,C31:V31,C36:V38,C41:V41,C46:V48,C32:D35,F32:H35,J32:L35,N32:P35"))
Union(Bereich1, Bereich2, Bereich3).ClearContents
End With
Next
End Sub
Wie bereits beschrieben, die Doppler suchst Du selbst raus, da hab ich keine Lust.
Sonst müsste man wissen an welcher Position(Index) die Blätter in der Datei stehen.
Ich vermute mal von Jan - Dez geordnet.
Gibt es mehr Blätter als die 12 müsste man die Position wissen, die dürfte dann aber nie geändert werden.
Ist also nicht 100% sicher.
So ziemlich sicher ist die eindeutige Referenzierung über den CodeNamen der Tabelle.
Dann bis morgen ...
Gruß Matthias

Anzeige
Schleife
06.04.2016 17:29:38
Michael
Hi zusammen,
dann so: 
Sub wechMit()
Dim c As Range
Dim z&, s&
Set c = Range("$C$4:$E$4,$C$5:$D$11,$E$9:$E$11,$F$4:$F$11")
For s = 0 To 4
For z = 0 To 3
' Zum Testen, und wenn es paßt, auskommentieren...
c.Offset(z * 9, s * 4).Interior.Color = vbYellow
' und dafür beim nächsten Befehl das Hochkomma entfernen:
' c.Offset(z * 9, s * 4).ClearContents
Next
Next
End Sub
Schöne Grüße,
Michael

AW: Schleife-Nachtrag
06.04.2016 17:36:46
Michael
hatte das mit den Monaten übersehen.
Das könnte man dann (auch) so machen: 
Sub wechMitAlle()
Dim sh As Worksheet
Dim c As Range
Dim z&, s&
For Each sh In Worksheets
If sh.Name  "OhneDiesesBlatt" Then
Set c = sh.Range("$C$4:$E$4,$C$5:$D$11,$E$9:$E$11,$F$4:$F$11")
For s = 0 To 4
For z = 0 To 3
' Zum Testen, und wenn es paßt, auskommentieren...
c.Offset(z * 9, s * 4).Interior.Color = vbYellow
' und dafür beim nächsten Befehl das Hochkomma entfernen:
' c.Offset(z * 9, s * 4).ClearContents
Next
Next
End If
Next
End Sub
Mit dem If kann man bestimmte Blätter von der Aktion ausschließen.
Schöne Grüße,
Michael

Anzeige
hat mein Bsp. nicht gereicht ? owT
06.04.2016 17:43:24
Matthias

Entschuldigung,
06.04.2016 17:54:41
Michael
Matthias,
das Erste hatte sich mit Deinem überschnitten, und das Zweite ist nur nachgebessert...
Sorry und schönen Tag,
Gruß,
Michael

AW: VBA Makroänderung
07.04.2016 05:30:24
Bernd
Hallo Matthias und Michael,
vielen lieben Dank für die Vorgeschlagenen Lösungen, werde damit etwas rumbasteln.
In der tatsache ist es so, dass ich nicht nur 12 Tabellenblätter in meiner Mappe habe, aber auch dass hoffe ich selbst lösen zu können.
Superhilfe von Euch beiden und nochmals ein dickes THX,
lg Bernd

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige