Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 16:33:24
Worksheets variable
18.04.2024 15:53:31
In Outlook (Exchange) Serientermin erstellen
18.04.2024 15:16:20
VBA Suchen, Kopieren, Einfügen
18.04.2024 15:16:07
Verschieben von Daten um bestimmte Zeilen nach unten
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1596to1600
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
1596to1600
1596to1600
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code optimieren

Code optimieren
20.12.2017 19:34:58
Marco
Guten Abend,
ich wollt mal in die Runde fragen ob man den Code schlanker machen kann? 
Sub StartLöschen()
Dim z As Integer
For z = 13 To 51
Sheets("1").Range(Cells(z, 10), Cells(z, 11)) = ""
Sheets("1").Range(Cells(z, 14), Cells(z, 15)) = ""
Sheets("1").Range(Cells(z, 18), Cells(z, 19)) = ""
Sheets("1").Range(Cells(z, 22), Cells(z, 23)) = ""
Sheets("1").Range(Cells(z, 10), Cells(z, 12)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 14), Cells(z, 16)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 18), Cells(z, 20)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 22), Cells(z, 24)).Interior.Pattern = xlNone
Next z
For z = 60 To 134
Sheets("1").Range(Cells(z, 10), Cells(z, 11)) = ""
Sheets("1").Range(Cells(z, 14), Cells(z, 15)) = ""
Sheets("1").Range(Cells(z, 18), Cells(z, 19)) = ""
Sheets("1").Range(Cells(z, 22), Cells(z, 23)) = ""
Sheets("1").Range(Cells(z, 10), Cells(z, 12)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 14), Cells(z, 16)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 18), Cells(z, 20)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 22), Cells(z, 24)).Interior.Pattern = xlNone
Next z
For z = 143 To 190
Sheets("1").Range(Cells(z, 10), Cells(z, 11)) = ""
Sheets("1").Range(Cells(z, 14), Cells(z, 15)) = ""
Sheets("1").Range(Cells(z, 18), Cells(z, 19)) = ""
Sheets("1").Range(Cells(z, 22), Cells(z, 23)) = ""
Sheets("1").Range(Cells(z, 10), Cells(z, 12)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 14), Cells(z, 16)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 18), Cells(z, 20)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 22), Cells(z, 24)).Interior.Pattern = xlNone
Next z
End Sub

Ich habe versucht den Code damit abzuspecken, aber das hat leider nicht funktioniert.
Geht so was nicht bei For Next Schleifen oder welche Regeln gibt es zu beachten? 
StartLöschen()
Dim z As Integer
For z = 13 To 51 and 60 To 134 and 143 To 190
Sheets("1").Range(Cells(z, 10), Cells(z, 11)) = ""
Sheets("1").Range(Cells(z, 14), Cells(z, 15)) = ""
Sheets("1").Range(Cells(z, 18), Cells(z, 19)) = ""
Sheets("1").Range(Cells(z, 22), Cells(z, 23)) = ""
Sheets("1").Range(Cells(z, 10), Cells(z, 12)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 14), Cells(z, 16)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 18), Cells(z, 20)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 22), Cells(z, 24)).Interior.Pattern = xlNone
Next z
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: teste mal
20.12.2017 19:57:34
Fennek 

For z = 13 To 190
select case z
case is 13 to 51, 60 to 134, 143 to 190
Sheets("1").Range(Cells(z, 10), Cells(z, 11)) = ""
Sheets("1").Range(Cells(z, 14), Cells(z, 15)) = ""
Sheets("1").Range(Cells(z, 18), Cells(z, 19)) = ""
Sheets("1").Range(Cells(z, 22), Cells(z, 23)) = ""
Sheets("1").Range(Cells(z, 10), Cells(z, 12)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 14), Cells(z, 16)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 18), Cells(z, 20)).Interior.Pattern = xlNone
Sheets("1").Range(Cells(z, 22), Cells(z, 24)).Interior.Pattern = xlNone
end select
Next z

Anzeige
AW: Code optimieren
20.12.2017 20:03:18
Ralf
Hi Marco,
das: 
For z = 13 To 51 and 60 To 134 and 143 To 190
geht in der Tat nicht....
Ungetestet (also besser mal mit einer Kopie probieren) könntest Du das versuchen:
Sub StartLöschen()
Dim z As Integer
Dim ber1 As Range, ber2 As Range, ber3 As Range, ber4 As Range, ber
Set ber1 = Sheets("1").Range(Cells(13, 10), Cells(51, 11))
Set ber2 = Sheets("1").Range(Cells(60, 10), Cells(134, 11))
Set ber3 = Sheets("1").Range(Cells(143, 10), Cells(190, 11))
For Each ber In ber1
Set ber4 = Union(ber, ber.Offset(0, 4), ber.Offset(0, 8), ber.Offset(0, 12), ber.Offset( _
0, 16))
ber4 = ""
ber4.Interior.Pattern = xlNone
Set ber4 = Nothing
Next
For Each ber In ber2
Set ber4 = Union(ber, ber.Offset(0, 4), ber.Offset(0, 8), ber.Offset(0, 12), ber.Offset( _
0, 16))
ber4 = ""
ber4.Interior.Pattern = xlNone
Set ber4 = Nothing
Next
For Each ber In ber3
Set ber4 = Union(ber, ber.Offset(0, 4), ber.Offset(0, 8), ber.Offset(0, 12), ber.Offset( _
0, 16))
ber4 = ""
ber4.Interior.Pattern = xlNone
Set ber4 = Nothing
Next
Set ber1 = Nothing
Set ber2 = Nothing
Set ber3 = Nothing
End Sub

Anzeige
AW: Code optimieren
20.12.2017 20:06:06
Ralf
Hi Marco,
das: 
For z = 13 To 51 and 60 To 134 and 143 To 190
geht in der Tat nicht....
Ungetestet (also besser mal mit einer Kopie probieren) könntest Du das versuchen:
Sub StartLöschen()
Dim z As Integer
Dim ber1 As Range, ber2 As Range, ber3 As Range, ber4 As Range, ber
Set ber1 = Sheets("1").Range(Cells(13, 10), Cells(51, 11))
Set ber2 = Sheets("1").Range(Cells(60, 10), Cells(134, 11))
Set ber3 = Sheets("1").Range(Cells(143, 10), Cells(190, 11))
For Each ber In ber1
Set ber4 = Union(ber, ber.Offset(4, 0), ber.Offset(8, 0), ber.Offset(12, 0), ber.Offset( _
16, 0))
ber4 = ""
ber4.Interior.Pattern = xlNone
Set ber4 = Nothing
Next
For Each ber In ber2
Set ber4 = Union(ber, ber.Offset(4, 0), ber.Offset(8, 0), ber.Offset(12, 0), ber.Offset( _
16, 0))
ber4 = ""
ber4.Interior.Pattern = xlNone
Set ber4 = Nothing
Next
For Each ber In ber3
Set ber4 = Union(ber, ber.Offset(4, 0), ber.Offset(8, 0), ber.Offset(12, 0), ber.Offset( _
16, 0))
ber4 = ""
ber4.Interior.Pattern = xlNone
Set ber4 = Nothing
Next
Set ber1 = Nothing
Set ber2 = Nothing
Set ber3 = Nothing
End Sub

Anzeige
AW: Code optimieren
20.12.2017 20:07:53
Ralf
..sorry... man kann einen einmal gesendeten Post nicht nachträglich editieren. Du musst die 2.Lösung nehmen, das Du ja zeilenweise verändern willst und nicht (wie im 1. Post) spaltenweise....
AW: Code optimieren
20.12.2017 20:12:30
Werner
Hallo Marco,
oder mit Union die Bereiche zusammenfassen. 
Sub StartLöschen()
Dim i As Long
With Worksheets("1")
For i = 10 To 22 Step 4
Union(.Range(.Cells(13, i), .Cells(51, i + 1)), .Range(.Cells(60, i), .Cells(134, i  _
+ 1)) _
, .Range(.Cells(143, i), .Cells(190, i + 1))).ClearContents
Union(.Range(.Cells(13, i), .Cells(51, i + 2)), .Range(.Cells(60, i), .Cells(134, i  _
+ 2)) _
, .Range(.Cells(143, i), .Cells(190, i + 2))).Interior.Pattern = xlNone
Next i
End With
End Sub
Gruß Werner
Anzeige
AW: Code optimieren
20.12.2017 20:28:40
Daniel
Hi
am besten ganz ohne Schleife alle Zellen in einem Step ansprechen und bearbeiten 
with Sheets("1")
With .Range("13:51,60:134,143:190")
Intersect(.Cells, .Range("J:K,N:O,R:S,V:W")).ClearContents
Intersect(.Cells, .Range("J:L,N:P,R:T,V:X")).Interior.Pattern = xlNone
End With
End with
Gruß Daniel
AW: Code optimieren
21.12.2017 04:11:38
Gerd
Moin, teste mal. 
Dim B As Range
Set B = Intersect(Sheets("1").Range("13:51,60:134,143:190"), _
Sheets("1").Range("J:K,N:O,R:S,V:W"))
B.ClearContents
Union(B, B.Offset(, 1)).Interior.Pattern = xlNone
Set B = Nothing

Gtuß Gerd
Anzeige
Vielen Dank an alle es funktioniert
22.12.2017 19:13:00
Marco
Nochmals danke an alle für die guten Lösungen
Gerne u. Danke für die Rückmeldung. o.w.T.
22.12.2017 19:46:09
Werner

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige