Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1304to1308
1304to1308
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro verschieben

Forumthread: Makro verschieben

Makro verschieben
04.04.2013 13:33:45
asomy
Hallo ich habe mir ein Makro aus dem Internet gesucht und es meinen Bedürfnissen angepasst. Es wird durch einen Button gestartet. Klappt einwandfrei.
Nun möchte ich aber Button und Makro auf ein separates Tabellenblatt (in der gleichen Mappe) verschieben.
Wie muss ich den Code anpassen, damit er weiterhin funktioniert?

Private Sub Button_Sommer()
Dim i As Integer
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
With Range("F" & i)
If .Value  "Sommer" And .Value  "" Then
.EntireRow.Hidden = True
End If
End With
Next i
End Sub
Vielen Dank

Anzeige

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro verschieben
04.04.2013 13:52:02
Klaus
Hi,
das müsste so gehen ("Tabelle1" natürlich auf deinen Tabellennamen anpassen) 
Private Sub Button_Sommer()
Dim i As Integer
with Sheets("Tabelle1")
For i = .UsedRange.Rows.Count To 1 Step -1
With .Range("F" & i)
If .Value  "Sommer" And .Value  "" Then
.EntireRow.Hidden = True
End If
End With
Next i
End Sub

Anzeige
AW: Makro verschieben
04.04.2013 14:05:19
asomy
Hallo Klaus,
danke für die schnelle Antwort!
Leider klappt das aber nicht.
Ich habe auch noch ein End With hinter Next i eingefügt, aber selbst damit werden entsprechende Zellen nicht ausgeblendet.

AW: Makro verschieben
04.04.2013 14:26:44
asomy
Folgendes funktioniert, wenn Makro und Button auf dem Tabellenblatt Gesamt stehen:
Private Sub Button_Sommer_Click()
Dim i As Integer
With Sheets("Gesamt")
For i = .UsedRange.Rows.Count To 1 Step -1
With Range("G" & i)
If .Value  "Sommer" And .Value  "" Then
.EntireRow.Hidden = True
End If
End With
Next i
End With
End Sub
Sobald ich Button und Makro auf ein anderes Tabellenblatt verschiebe, funktioniert es nicht mehr.

Anzeige
AW: Makro verschieben
04.04.2013 14:28:36
asomy
Sorry, vergessen den Beitrag als noch offen zu markieren.

AW: Makro verschieben
04.04.2013 14:30:44
Klaus
Hi,
falsch abgeschrieben!
Du hast:
With Range("G" & i)
ich hab aber vorgeschlagen:
With .Range("G" & i)
kleiner Punkt, große Wirkung!
Grüße,
Klaus M.vdT.

AW: Makro verschieben
04.04.2013 14:37:16
asomy
Hehe ^^
Bringen wir die Sache mal auf den Punkt: Absolut klasse! Das war's! Läuft einwandfrei!
Hast du evtl noch einen Tip wie ich für die Zeit (es dauert einige Sekunken bis er fertig ist) so eine Art Popup-Fenster als Info ("Bitte Warten") einblenden kann?

Anzeige
AW: Makro verschieben
04.04.2013 14:44:35
Klaus
Hi,
wenn eine Hilfsspalte recht ist (dafür währ eine Musterdatei gut ...) dann kann ich die Laufzeit des Makros auf unter eine Sekunde drücken.
Im Archiv gibt es ein paar Methoden, Zeilen rasend schnell auch ohne Hilfsspalte auszublenden. Da müsste ich aber etwas suchen.
Ein Fenster geht, ist aber nicht SO einfach. Besser so:
Mach ein neues Tab mit dem Namen "bitte warten". Da drinnen schreibst du in eine Wordart, eine Zelle oder eine TextBox "Hallo, es dauert noch!" und idealerweise ein Bild von einer Sanduhr (ich nehme gerne einen Affen mit Abakus ...).
Das Blatt blendest du vor dem Code ein, und nach dem Code wieder aus. Etwa so: 
Sub test()
Dim wksOld As Worksheet
Set wksOld = ActiveSheet
Sheets("bittewarten").Visible = True
Sheets("bittewarten").Activate
[DeinCode]
Sheets("bittewarten").Visible = xlVeryHidden
wksOld.Activate
End Sub

Ich mein aber, wir bekommen dein Makro so rasend schnell dass du das gar nicht mehr brauchst. Melde mich nachher nochmal (Musterdatei wär trotzdem gut!).
Grüße,
Klaus M.vdT.

Anzeige
gefunden:
04.04.2013 14:58:17
Klaus
Hallo Nochmal,
ich hab ein Makro von ErichG gefunden und umschreiben können. Ich behaupte mal, dass läuft so rasend schnell durch deine Datei dass du keine "Bitte Warten" Schilder mehr brauchst.
Sub ausblenden_schnell()
'Makro orignal by: ErichG
'https://www.herber.de/forum/messages/1306790.html
'geändert:
'Zeilen auszublenden (statt zu löschen)
'Auf Wort "Sommer" oder "" prüfen, statt auf doppler
Dim arrW, zz As Long, rngBlenden As Range
Dim iCol As Integer
Dim sKeep As String
Dim wksBlenden As Worksheet
'Hier den echten Tabellenblatt-Namen angeben!
Set wksBlenden = Sheets("Tabelle1")
'Hier die SPALTE angeben! Spalte G = 6 (A=1, B=2 usw)
iCol = 7
'Dieses Wort nicht ausblenden!
sKeep = "Sommer"
With wksBlenden
arrW = .Cells(1, iCol).Resize(.Cells(.Rows.Count, iCol).End(xlUp).Row)
For zz = 2 To UBound(arrW)
If arrW(zz, 1)  sKeep And arrW(zz, 1)  "" Then
If rngBlenden Is Nothing Then
Set rngBlenden = .Cells(zz, 1)
Else
Set rngBlenden = Union(rngBlenden, .Cells(zz, 1))
End If
Else
End If
Next
If Not rngBlenden Is Nothing Then rngBlenden.EntireRow.Hidden = True
End With
End Sub
Überleg dir nur kurz, ob du lieber:
a) ein Makro einsetzt, dass du begreifen und nachvollziehen kannst
b) eins nutzt, dass rasend schnell ist aber weit über deiner VBA Kentniss liegt
ich rate zu a, hab aber selbst immer zu b begriffen. Die Weisheit kam dann mit der Not, wenn ich Änderungen brauchte.
Grüße,
Klaus M.vdT.

Anzeige
noch schneller:
04.04.2013 15:12:29
Klaus
Hi,
der Vollständigkeit halber nochmal um den alseits beliebten "GetMoreSpeed" Standardsub ergänzt:
Sub ausblenden_schnell()
'Makro orignal by: ErichG
'https://www.herber.de/forum/messages/1306790.html
'geändert:
'Zeilen auszublenden (statt zu löschen)
'Auf Wort "Sommer" oder "" prüfen, statt auf doppler
'GetMoreSpeed Standardroutine eingefügt
Dim arrW, zz As Long, rngBlenden As Range
Dim iCol As Integer
Dim sKeep As String
Dim wksBlenden As Worksheet
'Hier den echten Tabellenblatt-Namen angeben!
Set wksBlenden = Sheets("Tabelle1")
'Hier die SPALTE angeben! Spalte G = 6 (A=1, B=2 usw)
iCol = 7
'Dieses Wort nicht ausblenden!
sKeep = "Sommer"
GetMoreSpeed (True)
With wksBlenden
arrW = .Cells(1, iCol).Resize(.Cells(.Rows.Count, iCol).End(xlUp).Row)
For zz = 2 To UBound(arrW)
If arrW(zz, 1)  sKeep And arrW(zz, 1)  "" Then
If rngBlenden Is Nothing Then
Set rngBlenden = .Cells(zz, 1)
Else
Set rngBlenden = Union(rngBlenden, .Cells(zz, 1))
End If
Else
End If
Next
If Not rngBlenden Is Nothing Then rngBlenden.EntireRow.Hidden = True
End With
GetMoreSpeed (False)
End Sub
Public Static Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True)
Dim intCalculation As Integer
If Modus = True Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.Calculation = IIf(Modus = True, xlManual, intCalculation)
.Cursor = IIf(Modus = True, 2, -4143)
End With
End Sub
Grüße,
Klaus M.vdT.

Anzeige
AW: gefunden:
04.04.2013 15:23:48
asomy
Ähmm, ich hab's einfach mal ausprobiert. oÔ
Ich denke du verstehst, dass ich zu B greife. Der war ja schon fertig, bevor ich richtig durchgeklickt hatte! Wahnsinn...
Da ich die Tabelle für große Datenmengen (ein paar Tausend) einsetzen muss, spar' ich mir die Sache mit dem Rechenschieber ^^
Danke für die Hilfe, Klaus!
VG
asomy

Anzeige
Danke für die Rückmeldung!
04.04.2013 15:28:56
Klaus
Ich denke du verstehst, dass ich zu B greife.
Versteh ich gut, rate aber zu Lösung A. Allerdings bin ich Raucher, hab also vollstes Verständniss für bewusst schlechte Entscheidungen :-)
Grüße,
Klaus M.vdT.
(an dieser Stelle von mir: Vielen Dank an ErichG, den Trick mit dem Array werd ich noch öfters benutzen!)

Anzeige
AW: Makro verschieben
04.04.2013 14:29:22
Klaus
Hi,
ja, das "end with" fehlte. Aber damit läuft der Code bei mir 1A.
Ich vermute mal, du hast ein Problem mit "usedrange.Rows.count". Wenn du zB nur in Zeile 17 und 18 etwas schreibst, aber davor nichts, ergibt das 2 (da insgesamt zwei Zeilen genutzt werden).
Ich schreib das mal eben um: 
Private Sub CommandButton1_Click()
Dim i As Integer
With Sheets("Tabelle1")
For i = .Cells(.Rows.Count, 6).End(xlUp).Row To 1 Step -1
With .Range("F" & i)
If .Value  "Sommer" And .Value  "" Then
.EntireRow.Hidden = True
End If
End With
Next i
End With
End Sub

jetzt nimmt er als Basis die letzte Zeile in F.
Bei der Gelegenheit, der Code hat etwas Ballast. Genauso funktional, aber etwas eleganter: 

Sub eleganter()
Dim r As Range
With Sheets("Tabelle1")
For Each r In .Range("F1:F" & .Cells(.Rows.Count, 6).End(xlUp).Row)
If r.Value  "Sommer" And r.Value  "" Then r.EntireRow.Hidden = True
Next r
End With
End Sub
Grüße,
Klaus M.vdT.
Anzeige
;

Beliebteste Forumthreads (12 Monate)

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