Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1904to1908
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

Makro funktioniert nicht richtig

Makro funktioniert nicht richtig
26.10.2022 20:11:40
mike49
Hallo Leute,
ich habe ein Löschen-Makro, das in den Blättern Jan-Dez den Bereich E6:H36 und die Zelle R6 löschen soll.
Beim Drücken des Löschen-Buttons in einem Monatsblatt gehen auch die msg-Boxen auf und am Ende kommt auch die Meldung, dass alle Blätter auf Null gesetzt wurden, wenn dies gewünscht wird.
Dem ist aber nicht so. Es werden nur die Werte im aktiven Blatt zurückgesetzt. Die Werte in den anderen Blättern aber nicht!
Was habe ich falsch gemacht?
Sub Löschen()
'Sub Löschen(Optional Dummy As Byte)
Dim strAntwort As String
strAntwort = MsgBox("Achtung: Das gesamte Tabellenblatt wird zurückgesetzt!", _
vbExclamation + vbOKCancel, "Hinweis")
If strAntwort = vbCancel Then Exit Sub 'Bei "Abbrechen" abbrechen.
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
.Calculation = xlCalculationManual
End With
With ActiveSheet
' .Unprotect
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
' .Protect
End With
strAntwort = MsgBox("Die anderen Tabellenblätter ebenfalls zurücksetzen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Frage")
If strAntwort = vbYes Then
If ANDERE_TABELLEN = True Then
MsgBox "Alle Monate auf Null gesetzt.", vbInformation, "Information"
End If
End If
With Application
.ScreenUpdating = True 'Bildschirmaktualisierung abschalten.
.EnableEvents = True 'Ereignissprozeduren deaktivieren.
.Calculation = xlCalculationAutomatic
' .ActiveWindow.ScrollRow = 9
End With
End Sub

Private Function ANDERE_TABELLEN() As Boolean
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name  ActiveSheet.Name And Len(Sh.Name) = 3 Then
If TABELLE_AUF_NULL(Sh.Name) = False Then
MsgBox "Fehler bei Tabelle: " & Sh.Name, _
vbCritical, "Abbruch"
Exit Function
End If
End If
Next
ANDERE_TABELLEN = True 'Erfolg vermerken.
End Function

Private Function TABELLE_AUF_NULL(strTabelle As String) As Boolean
'    On Error GoTo Ende 'Fehlerbehandlung übernehmen.
With ThisWorkbook.Sheets(strTabelle) 'Alles auf dieses Tabellenblatt beziehen:
.Unprotect
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
' .Range("F42").Value = "0"
'       ActiveWindow.ScrollRow = 9
'       ThisWorkbook.Sheets("Jan").Range("R6").Value = "0"
'       ThisWorkbook.Sheets("Jan").Activate
End With
TABELLE_AUF_NULL = True 'Erfolg vermerken.
Ende:
'    On Error GoTo 0 'Fehlerbehandlung zurückgeben.
End Function
Gruß
mike49

27
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro funktioniert nicht richtig
26.10.2022 20:47:12
Daniel
Hi
der Code ist zwar unnötig umständlich, funktioniert aber bei mir.
Wenns bei dir nicht tut, dann liegt es nicht am Code, sondern an der Datei, bzw daren, dass du im Code was annimmst, was aber nicht zutrifft.
ohne deine Datei zu kennen, würde ich mal darauf tippen, dass deine Tabellenblätter die falsche Benennung haben, diese muss nämlich drei Zeichen lang sein:
If Sh.Name ActiveSheet.Name And Len(Sh.Name) = 3 Then
hat sie mehr oder weniger Zeichen, dann wird das Blatt übersprungen.
Gruß Daniel
AW: Makro funktioniert nicht richtig
26.10.2022 21:39:32
mike49
Hallo Daniel,
danke für die schnelle Hilfe.
Ich habe die Länge in 8 geändert. Hat aber nichts gebracht. Gelöscht werden nur die Einträge des aktiven Blatts.
Ich lade mal die Datei hoch. Vielleicht findest du den Fehler?
https://www.herber.de/bbs/user/155877.xlsm
LG
Anzeige
Juni hat nur 4 Zeichen, September 9 etc.
26.10.2022 21:50:18
Rudi
auch wenn es mir widerstrebt:
ändere
If Sh.Name ActiveSheet.Name And Len(Sh.Name) = 8 Then
in
if isDate("1." & sh.Name) Then
Gruß
Rudi
prinzipieller Fehler/ Missbrauch
26.10.2022 21:42:48
Rudi
Hallo,
Functions sind dazu da, Werte zurückzugeben und nicht dazu, irgendwelche Aktionen durchzuführen. Das ist ganz schlechter Stil.
Gruß
Rudi
AW: prinzipieller Fehler/ Missbrauch
26.10.2022 21:56:56
mike49
Hallo Rudi,
danke für die Info.
Vor Jahren wurde hier im Forum dieses Löschen-Makro von einem deiner Kollegen für meinen Zweck erstellt. Es funktioniert und ich nutze es seitdem.
Da meine VBA-Kenntnisse nicht gut sind, kann ich mit deiner sicher berechtigten Kritik nichts anfangen.
Aber vielleicht kannst du mir sagen, wie du's gelöst hättest? Wäre schön.
Gruß
mike49
Anzeige
AW: prinzipieller Fehler/ Missbrauch
26.10.2022 21:59:25
Rudi

von einem deiner Kollegen für meinen Zweck erstellt.
wenn ich den erwische.... ;-)
AW: prinzipieller Fehler/ Missbrauch
26.10.2022 22:38:50
mike49
Hi Rudi,
habe mich zu früh gefreut.
Die Anderen Blätter werden trotz deine vorgeschlagenen Änderung doch nicht zurückgesetzt. Nur das jeweils aktive Blatt.
Hast du noch eine Idee woran es iegen kann?
Gruß
funktioniert bei mir. owT
26.10.2022 23:45:57
Rudi
ohne Function
27.10.2022 09:42:02
Rudi

Sub Loeschen()
Dim strAntwort As String, wks As Worksheet, lngCALC As Long, strERR As String
strAntwort = MsgBox("Achtung: Das gesamte Tabellenblatt wird zurückgesetzt!", _
vbExclamation + vbOKCancel, "Hinweis")
If strAntwort = vbCancel Then Exit Sub 'Bei "Abbrechen" abbrechen.
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
lngCALC = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
End With
strAntwort = MsgBox("Die anderen Tabellenblätter ebenfalls zurücksetzen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Frage")
If strAntwort = vbYes Then
For Each wks In Worksheets
With wks
If IsDate("1." & .Name) Then
If .ProtectContents Then
strERR = strERR & vbLf & wks.Name
Else
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
End If
End If
End With
Next wks
If Len(strERR) Then
MsgBox "Blätter" & strERR & vbLf & "konnten nicht zurückgesetzt werden.", , "Gebe bekannt..."
Else
MsgBox "Alle Monate auf Null gesetzt.", vbInformation, "Information"
End If
End If
With Application
.EnableEvents = True 'Ereignissprozeduren aktivieren.
.Calculation = lngCALC
End With
End Sub

Anzeige
AW: ohne Function
27.10.2022 11:20:44
mike49
Hi Rudi,
danke dass du eine elegante Lösung erstellt hast.
Nur eines funktioniert nicht:
Wenn ich zusätzlich die Zeile ".Range("E6").Select" einfüge, wird das nur beim Löschen des aktuellen Blatts ausgeführt. Bei den anderen Tabellenblättern nicht. Es wird ein Fehler zum Debuggen angezeigt.
gruß
mike49
AW: ohne Function
27.10.2022 13:11:51
Rudi
natürlich geht das nicht, da die Worksheets nicht selected werden, wie es sich gehört.
Wenn du unbedingt E6 jeweils markieren willst, kannst du das mit einem kleinen Trick bewerkstelligen:

    For Each wks In Worksheets
With wks
If IsDate("1." & .Name) Then
If .ProtectContents Then
strERR = strERR & vbLf & wks.Name
Else
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
End If
End If
With .Range("E6")
.Copy
.PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False
End With
Next wks
Gruß
Rudi
Anzeige
AW: ohne Function
27.10.2022 13:49:34
Daniel
Hi
das .Select einer Zelle kannst du nur im aktiven Tabellenblatt durchführen.
Willst du eine Zelle selektieren, die auf einem anderen Blatt liegt, müsstest du zuerst das Blatt selektieren, oder mit Application.Goto dahin springen:

with wks
.Select
.Range("E6").Select
....
oder

with wks
Application.Goto .Range("E6")
....
Gruß Daniel
AW: ohne Function
27.10.2022 14:07:21
Rudi
auf einem nicht aktiven Blatt kannst du eine bestimmte Zelle mit Copy/Pastespecial aktivieren.
Blatt 1 aktiv, J10 auf Blatt2 aktivieren:

Sub a()
With Sheets(2).Cells(10, 10)
.Copy
.PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False
End Sub
Gruß
Rudi
Anzeige
AW: ohne Function
27.10.2022 14:16:21
mike49
Hi Leute,
danke, dass ihr euch bemüht, mir das zu "verklickern". Ich weiß jetzt nur, dass ich nichts weiß 😞
Wie müsste denn das ganze Makro aussehen?
LG
das ganze Makro ...
27.10.2022 14:26:57
Rudi
...sieht so aus:

Sub Loeschen()
Dim strAntwort As String, wks As Worksheet, lngCALC As Long, strERR As String
strAntwort = MsgBox("Achtung: Das gesamte Tabellenblatt wird zurückgesetzt!", _
vbExclamation + vbOKCancel, "Hinweis")
If strAntwort = vbCancel Then Exit Sub 'Bei "Abbrechen" abbrechen.
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
lngCALC = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
End With
strAntwort = MsgBox("Die anderen Tabellenblätter ebenfalls zurücksetzen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Frage")
If strAntwort = vbYes Then
For Each wks In Worksheets
With wks
If IsDate("1." & .Name) Then
If .ProtectContents Then
strERR = strERR & vbLf & wks.Name
Else
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
End If
End If
With .Range("E6")
.Copy
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End With
Next wks
If Len(strERR) Then
MsgBox "Blätter" & strERR & vbLf & "konnten nicht zurückgesetzt werden.", , "Gebe bekannt..."
Else
MsgBox "Alle Monate auf Null gesetzt.", vbInformation, "Information"
End If
End If
With Application
.EnableEvents = True 'Ereignissprozeduren aktivieren.
.Calculation = lngCALC
End With
End Sub

Anzeige
AW: das ganze Makro ...
27.10.2022 15:12:07
mike49
Hallo Rudi,
danke für das Makro. Funktioniert leider nicht. Es kommt immer noch 'Laufzeitfehler 1004'
Gruß
mike49
AW: das ganze Makro ...
27.10.2022 15:15:41
Rudi
Hallo,
hast du verbundene Zellen in E6:H36?
jetzt aber ...
27.10.2022 15:21:33
Rudi

Sub Loeschen()
Dim strAntwort As String, wks As Worksheet, lngCALC As Long, strERR As String
strAntwort = MsgBox("Achtung: Das gesamte Tabellenblatt wird zurückgesetzt!", _
vbExclamation + vbOKCancel, "Hinweis")
If strAntwort = vbCancel Then Exit Sub 'Bei "Abbrechen" abbrechen.
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
lngCALC = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
End With
strAntwort = MsgBox("Die anderen Tabellenblätter ebenfalls zurücksetzen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Frage")
If strAntwort = vbYes Then
For Each wks In Worksheets
With wks
If IsDate("1." & .Name) Then
If .ProtectContents Then
strERR = strERR & vbLf & wks.Name
Else
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
With .Range("E6")
.Copy
.PasteSpecial xlPasteValues
End With
End If
End If
Application.CutCopyMode = False
End With
Next wks
If Len(strERR) Then
MsgBox "Blätter" & strERR & vbLf & "konnten nicht zurückgesetzt werden.", , "Gebe bekannt..."
Else
MsgBox "Alle Monate auf Null gesetzt.", vbInformation, "Information"
End If
End If
With Application
.EnableEvents = True 'Ereignissprozeduren aktivieren.
.Calculation = lngCALC
End With
End Sub
Gruß
Rudi
Anzeige
AW: jetzt aber ...
27.10.2022 15:48:26
mike49
Ja Rudi jetzt klappts! 👏 Super
Ich würde das Makro noch gerne erweitern.
Im Bereich D6:D36 werden die Feiertage gemäß Formel eingetragen.
Wenn ich nun diese mit "Urlaub", "Krank" oder "Feiertag" überschreiben muss, ist diese weg und ich muss sie händisch wieder einfügen.
Ich möchte nun beim Löschen erreichen, dass die überschriebenen Formeln wieder eingefügt werden.
Ich lade die aktuelle Datei mal hoch.
https://www.herber.de/bbs/user/155897.xlsm
Vielen Dank schon mal im Voraus.
Gruß
mike49
AW: jetzt aber ...
27.10.2022 17:05:10
Rudi
kannst du auch was selbst?

Sub Loeschen()
Dim strAntwort As String, wks As Worksheet, lngCALC As Long, strERR As String
strAntwort = MsgBox("Achtung: Das gesamte Tabellenblatt wird zurückgesetzt!", _
vbExclamation + vbOKCancel, "Hinweis")
If strAntwort = vbCancel Then Exit Sub 'Bei "Abbrechen" abbrechen.
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
lngCALC = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
.Range("D6:D36").FormulaR1C1 = "=iferror(vlookup(rc[-2],c17:c18,2,),"""")"
End With
strAntwort = MsgBox("Die anderen Tabellenblätter ebenfalls zurücksetzen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Frage")
If strAntwort = vbYes Then
For Each wks In Worksheets
With wks
If IsDate("1." & .Name) Then
If .ProtectContents Then
strERR = strERR & vbLf & wks.Name
Else
.Range("E6:H36").ClearContents
.Range("R6").ClearContents
.Range("D6:D36").FormulaR1C1 = "=iferror(vlookup(rc[-2],c17:c18,2,),"""")"
With .Range("E6")
.Copy
.PasteSpecial xlPasteValues
End With
End If
End If
Application.CutCopyMode = False
End With
Next wks
If Len(strERR) Then
MsgBox "Blätter" & strERR & vbLf & "konnten nicht zurückgesetzt werden.", , "Gebe bekannt..."
Else
MsgBox "Alle Monate auf Null gesetzt.", vbInformation, "Information"
End If
End If
With Application
.EnableEvents = True 'Ereignissprozeduren aktivieren.
.Calculation = lngCALC
End With
End Sub
dann steht wenigstens eine vernünftige Formel drin. ;-)
Gruß
Rudi
Anzeige
AW: jetzt aber ...
27.10.2022 18:18:37
mike49
Wow! Das ist super. War mir zu kompliziert.
Wie muss ich die Zeile .Range("D6:D36").FormulaR1C1 = "=iferror(vlookup(rc[-2],c17:c18,2,),"""")" abändern, damit nicht alle Bezeichnungen des Bereichs R9:R40 eingetragen werden, sondern nur die vom Bereich R9:R28. Die Bezeichnungen mit * also nicht.
LG
AW: jetzt aber ...
27.10.2022 19:07:23
mike49
Hi Rudi,
ich habe versucht, es selber zu lösen. Ist zwar nicht die beste Version, aber es klappt:
.Range("D6:D36").FormulaLocal = _
"=WENN(ISTNV(INDEX($Q$9:$R$39;VERGLEICH($B6;$Q$9:$Q$39;0);2));"""";INDEX($Q$9:$R$39;VERGLEICH($B6;$Q$9:$Q$39;0);2))"
Vielen lieben Dank für deine Geduld und die super Hilfe!
Gruß
mike49
Anzeige
AW: jetzt aber ...
27.10.2022 20:49:36
Rudi
.Range("D6:D36").FormulaR1C1 = "=iferror(vlookup(rc[-2],r9c17:r28c18,2,),"""")"
AW: jetzt aber ...
28.10.2022 15:09:22
mike49
Hi Rudi,
komme erst jetzt dazu, dir zu danken. Es klappt und sieht "aufgeräumt" aus. Diese Schreibweise kannte ich nicht.
Eines hätte ich noch:
Nach dem Löschen wird ja die Zelle E6 aktiviert. Jetzt sollten auch noch die Blätter an den Anfang gescrollt werden, damit man das nicht manuell tun muss.
Welche Zeile müsste noch eingefügt werden?
Gruß
mike49
AW: ohne Function
27.10.2022 14:07:57
mike49
Hallo Daniel,
schön, dass du dich auch meldest.
Ich habe aber mit dem Einfügen deiner Variante Probleme.
Könntest du mir vielleicht sagen, wie das Makro dann auszusehen hat?
Gruß
mike49
AW: ohne Function
27.10.2022 15:14:09
mike49
Hallo Daniel,
hätte auch mal deine Variante getestet.
Wie würde bei dir das ganze Makro aussehen?
Gruß
mike49
Hat sich erledigt . . .
27.10.2022 15:49:58
mike49
Danke Daniel

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige