Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1532to1536
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
VBA Code Einfacher gestalten ?
12.01.2017 08:14:46
Sven
Hi Leute,
kann man den unten angefügten VBA Code einfacher bzw. so umschreiben das er schneller funktioniert ?
LG
Sven
Sub ZeilenAusblenden()
ActiveSheet.Unprotect
If IsEmpty(Range("AA6").Value) = True Then
Range("8:9,61:62,114:115,167:168,220:221,273:274").EntireRow.Hidden = True
Else
Range("8:9,61:62,114:115,167:168,220:221,273:274").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA7").Value) = True Then
Range("10:11,63:64,116:117,169:170,222:223,275:276").EntireRow.Hidden = True
Else
Range("10:11,63:64,116:117,169:170,222:223,275:276").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA8").Value) = True Then
Range("12:13,65:66,118:119,171:172,224:225,277:278").EntireRow.Hidden = True
Else
Range("12:13,65:66,118:119,171:172,224:225,277:278").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA9").Value) = True Then
Range("14:15,67:68,120:121,173:174,226:227,279:280").EntireRow.Hidden = True
Else
Range("14:15,67:68,120:121,173:174,226:227,279:280").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA10").Value) = True Then
Range("16:17,69:70,122:123,175:176,228:229,281:282").EntireRow.Hidden = True
Else
Range("16:17,69:70,122:123,175:176,228:229,281:282").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA11").Value) = True Then
Range("18:19,71:72,124:125,177:178,230:231,283:284").EntireRow.Hidden = True
Else
Range("18:19,71:72,124:125,177:178,230:231,283:284").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA12").Value) = True Then
Range("20:21,73:74,126:127,179:180,232:233,285:286").EntireRow.Hidden = True
Else
Range("20:21,73:74,126:127,179:180,232:233,285:286").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA13").Value) = True Then
Range("22:23,75:76,128:129,181:182,234:235,287:288").EntireRow.Hidden = True
Else
Range("22:23,75:76,128:129,181:182,234:235,287:288").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA14").Value) = True Then
Range("24:25,77:78,130:131,183:184,236:237,289:290").EntireRow.Hidden = True
Else
Range("24:25,77:78,130:131,183:184,236:237,289:290").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA15").Value) = True Then
Range("26:27,79:80,132:133,185:186,238:239,291:292").EntireRow.Hidden = True
Else
Range("26:27,79:80,132:133,185:186,238:239,291:292").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA16").Value) = True Then
Range("28:29,81:82,134:135,187:188,240:241,293:294").EntireRow.Hidden = True
Else
Range("28:29,81:82,134:135,187:188,240:241,293:294").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA17").Value) = True Then
Range("30:31,83:84,136:137,189:190,242:243,295:296").EntireRow.Hidden = True
Else
Range("30:31,83:84,136:137,189:190,242:243,295:296").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA18").Value) = True Then
Range("32:33,85:86,138:139,191:192,244:245,297:298").EntireRow.Hidden = True
Else
Range("32:33,85:86,138:139,191:192,244:245,297:298").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA19").Value) = True Then
Range("34:35,87:88,140:141,193:194,246:247,299:300").EntireRow.Hidden = True
Else
Range("34:35,87:88,140:141,193:194,246:247,299:300").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA20").Value) = True Then
Range("36:37,89:90,142:143,195:196,248:249,301:302").EntireRow.Hidden = True
Else
Range("36:37,89:90,142:143,195:196,248:249,301:302").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA21").Value) = True Then
Range("38:39,91:92,144:145,197:198,250:251,303:304").EntireRow.Hidden = True
Else
Range("38:39,91:92,144:145,197:198,250:251,303:304").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA22").Value) = True Then
Range("40:41,93:94,146:147,199:200,252:253,305:306").EntireRow.Hidden = True
Else
Range("40:41,93:94,146:147,199:200,252:253,305:306").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA23").Value) = True Then
Range("42:43,95:96,148:149,201:202,254:255,307:308").EntireRow.Hidden = True
Else
Range("42:43,95:96,148:149,201:202,254:255,307:308").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA24").Value) = True Then
Range("44:45,97:98,150:151,203:204,256:257,309:310").EntireRow.Hidden = True
Else
Range("44:45,97:98,150:151,203:204,256:257,309:310").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA25").Value) = True Then
Range("46:47,99:100,152:153,205:206,258:259,311:312").EntireRow.Hidden = True
Else
Range("46:47,99:100,152:153,205:206,258:259,311:312").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA26").Value) = True Then
Range("48:49,101:102,154:155,207:208,260:261,313:314").EntireRow.Hidden = True
Else
Range("48:49,101:102,154:155,207:208,260:261,313:314").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA27").Value) = True Then
Range("50:51,103:104,156:157,209:210,262:263,315:316").EntireRow.Hidden = True
Else
Range("50:51,103:104,156:157,209:210,262:263,315:316").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA28").Value) = True Then
Range("52:53,105:106,158:159,211:212,264:265,317:318").EntireRow.Hidden = True
Else
Range("52:53,105:106,158:159,211:212,264:265,317:318").EntireRow.Hidden = False
End If
If IsEmpty(Range("AA29").Value) = True Then
Range("54:55,107:108,160:161,213:214,266:267,319:320").EntireRow.Hidden = True
Else
Range("54:55,107:108,160:161,213:214,266:267,319:320").EntireRow.Hidden = False
End If
ActiveSheet.Protect
End Sub

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

Betreff
Datum
Anwender
Anzeige
ungetestet
12.01.2017 08:27:17
lupo1

Sub ZeilenAusblenden()
ActiveSheet.Unprotect
a = "8:9,61:62,114:115,167:168,220:221,273:274"
For i = 0 to 23
Range(a).Offset(i * 2).EntireRow.Hidden = IsEmpty(Cells(6 + i, 27).Value)
Next
ActiveSheet.Protect
End Sub

Schneller geht es möglicherweise mit
12.01.2017 08:40:57
lupo1
.Union, wobei ich grad nicht weiß, wie lang die Bereichsverkettung werden darf.
Direkt im Range(Bereichsverkettung) ist es recht früh begrenzt.
Vielleicht bringt folgendes noch ein paar Körner, ohne dass man jetzt bei mehreren IsEmpty's hintereinander die Einzelbereiche spreizt, z.B. auf 8:11,... oder 8:13,..., was viel bringen würde, aber den Code wieder etwas länger macht:
Sub ZeilenAusblenden()
ActiveSheet.Unprotect
Cells.EntireRow.Hidden = False 'nur wenn Ausblendung auf folgende Zeilen begrenzt
a = "8:9,61:62,114:115,167:168,220:221,273:274"
For i = 0 to 23
If IsEmpty(Cells(6 + i, 27).Value) Then Range(a).Offset(i * 2).EntireRow.Hidden = True
Next
ActiveSheet.Protect
End Sub

Anzeige
AW: VBA Code Einfacher gestalten ?
12.01.2017 09:12:40
guenni
Schneller geht,
1) Application.ScreenUpdating und Application.Calculation vorher aus- und danach wieder anschalten.
2) Hidden nur setzten, wenn es sich ändert (alle Folgezellen - falls Du den aktuellen Zustand kennst.
Vereinfachen sehe ich nur Kosmetik, da ich keinen systematischen Aufbau erkennen kann.
A)

If IsEmpty(Range("AA6").Value) = True Then
wird zu
If IsEmpty(Range("AA6").Value) Then

B) Wenn Schneller 2) nicht geht, kann aus
If IsEmpty(Range("AA25").Value) = True Then
Range("46:47,99:100,152:153,205:206,258:259,311:312").EntireRow.Hidden = True
Else
Range("46:47,99:100,152:153,205:206,258:259,311:312").EntireRow.Hidden = False
End If

folgendes werden

Range("46:47,99:100,152:153,205:206,258:259,311:312").EntireRow.Hidden = IsEmpty(Range("AA25"). _
Value)

Gruß,
Günther
Anzeige
Mit Autofilter ...
12.01.2017 09:36:34
lupo1
... geht das ganze viel schneller, falls Du Dich auf eine Hilfsspalte neben (oder auch entfernt neben) den potenziellen Ausblendzeilen einlässt.
Ungünstig ist bei Dir, dass AA6:AA29 sich mit dem Ausblendbereich überschneidet. So etwas sollte man grundsätzlich nicht tun.
AW: Mit Autofilter ...
12.01.2017 11:07:31
Sven
Wie meinst du das mit der Hilfsspalte ? Und mit dem vermeiden ?
Ich könnte helfen, wenn
12.01.2017 18:37:15
lupo1
AA6:A29 überschneidet sich mit den auszublendenden Zeilen ab 8,... und ist dann nicht zu sehen. Willst Du das?
Die Formel der Hilfsspalte kann ich Dir bauen, aber löse das obige zuerst und sag mir dann, wohin die Zeilen und die 24 Felder gewechselt sind!
Anzeige
AW: Ich könnte helfen, wenn
13.01.2017 14:05:59
Sven
So habe das jetzt mal geändert .
Jetzt befinden sich die Referenz zeilen ab A332 . Dort ist jetzt eine Tabelle die Mittels UserForm ausgefüllt oder geleert wird.
Sorry für die Späte Antwort , hatte nen bisl stress.
LG
Sven
noch ne Variante
15.01.2017 19:58:42
Michael
Hi,
Sub test()
Dim a, b, z&, z0&, z3&
Const alle = "8,61,114,167,220,273" ' sind ja immer 2
Dim aa
Dim t0 As Single
t0 = Timer
ActiveSheet.UnProtect
aa = Split(alle, ",")
ReDim a(8 To 320, 1 To 2)
b = Range("A332:A355")
For z = 8 To 320
a(z, 1) = Rows(z).Hidden
Next
z3 = 0
For z = 1 To 24
For z0 = LBound(aa) To UBound(aa)
a(z3 + aa(z0), 2) = b(z, 1) = ""
Next
z3 = z3 + 2
Next
Application.ScreenUpdating = False
'Stop
For z = 8 To 320
If a(z, 1)  a(z, 2) Then Rows(z & ":" & z + 1).Hidden = a(z, 2)
Next
ActiveSheet.Protect
MsgBox Timer - t0
End Sub
geht davon aus, daß die Zeilen 8-320 interessant sind und die "Steuerwerte" in A332:A355 stehen; bitte ggf. oben entsprechend anpassen.
Gruß,
Michael
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige