Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1056to1060
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
1056to1060
1056to1060
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro vereinfachen?

Makro vereinfachen?
13.03.2009 19:13:42
werner
Hallo zusammen,
ich habe eine größere Datei in der ich merere Makros habe.
Folgendes makro habe ich insgesamt 130 mal mit jeweils anderen Zellbezügen in einen Modul hinterlegt.
Sub ma1geez()
With Sheets("Gehälter")
If .Range("N11") = 1 Then
If MsgBox("soll die Erhöhung von " & " " & .Range("A11") & _
" wirklich übernommen werden?", vbYesNo) = vbYes Then
Range("R3") = .Range("Y2")
.Range("G11") = Sheets("Tabelle1").Range("E20")
ma1ü
Sheets("Tabelle1").Range("J14") = 0
Else
Sheets("Tabelle1").Range("J14") = 0
End If
End If
If .Range("O11") = 1 Then
If MsgBox("Bitte bestätigen Sie die Aktualisierung von" & " " & .Range("A11"), vbYesNo) = vbYes Then
.Range("R11") = Range("J11")
.Range("R3") = .Range("Y2")
ma1ü
Range("G11") = ""
Else
Range("G11") = ""
End If
End If
End With
End Sub


im der Datei habe ich dann folgendes Makro


Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Application.EnableEvents = False
ma1geez
ma2geez
ma3geez
ma4geez
ma5geez
ma6geez
ma7geez
ma8geez
ma9geez
ma10geez
ma11geez
ma12geez
ma13geez
ma14geez
ma15geez
ma16geez
ma17geez
ma18geez
ma19geez
ma20geez
ma21geez
ma22geez
ma23geez
ma24geez
ma25geez
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Gibt es eine Möglichkeit das ganze zu verkürzen?
Gruß Werner

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro vereinfachen?
13.03.2009 19:20:07
Josef
Hallo Werner,
zeig mal den Code von "ma1geez" und "ma2geez" um die Unterschiede zu sehen.
Sind die Unterschiede Linear?
Gruß Sepp

Was soll dieser ganze Quatsch!
13.03.2009 19:34:24
Renee
Hi Werner,
Langsam muss ich annehmen, dass du hier nur rumtrollen willst.
Dieses Konstrukt taucht nun schon zum 5ten oder 6ten mal auf.
Du hast unter anderem von mir und anderen Vorschläge bekommen, wie du das in einer Schleife lösen kannst. Sorry aber so vergeht einem die Lust (auch nur zu antworten!)
GreetZ Renée
Hallo Renee, hallo Sepp
13.03.2009 19:50:58
werner
Hallo Renee,
zuerst einmal entschuldigung an alle, ich will hier nicht rumtrollen sondern ich habe mich und meine Kenntnisse wahrscheinlich überschätzt und komme da nicht ganz klar. Ich werde mich bessern.
Für Renee nochmal die Unterschiede der Makros

Sub ma1geez()
With Sheets("Gehälter")
If .Range("N11") = 1 Then
If MsgBox("soll die Erhöhung von " & " " & .Range("A11") & _
" wirklich übernommen werden?", vbYesNo) = vbYes Then
Range("R3") = .Range("Y2")
.Range("G11") = Sheets("Tabelle1").Range("E20")
ma1ü
Sheets("Tabelle1").Range("J14") = 0
Else
Sheets("Tabelle1").Range("J14") = 0
End If
End If
If .Range("O11") = 1 Then
If MsgBox("Bitte bestätigen Sie die Aktualisierung von" & " " & .Range("A11"), vbYesNo) _
= vbYes Then
.Range("R11") = Range("J11")
.Range("R3") = .Range("Y2")
ma1ü
Range("G11") = ""
Else
Range("G11") = ""
End If
End If
End With
End Sub




Sub ma2geez()
With Sheets("Gehälter")
If .Range("N12") = 1 Then
If MsgBox("soll die Erhöhung von " & " " & .Range("A12") & _
" wirklich übernommen werden?", vbYesNo) = vbYes Then
Sheets("Gehälter").Range("R3") = .Range("Y2")
.Range("G12") = Sheets("Tabelle2").Range("E20")
ma2ü
Sheets("Tabelle2").Range("J14") = 0
Else
Sheets("Tabelle2").Range("J14") = 0
End If
End If
If .Range("O12") = 1 Then
If MsgBox("Bitte bestätigen Sie die Aktualisierung von" & " " & .Range("A12"), vbYesNo) _
= vbYes Then
Sheets("Gehälter").Range("R12") = .Range("J12")
Sheets("Gehälter").Range("R3") = .Range("Y2")
ma2ü
Range("G12") = ""
Else
Range("G12") = ""
End If
End If
End With
End Sub


Gruß Werner

Anzeige
AW: Hallo Renee, hallo Sepp
13.03.2009 20:20:49
Josef
Hallo Werner,
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub MAgeez(ByVal TabNumber As Long)
  Dim objWs As Worksheet
  
  Set objWs = Sheets("Tabelle" & CStr(TabNumber))
  
  With Sheets("Gehälter")
    If .Cells(10 + TabNumber, 14) = 1 Then
      If MsgBox("soll die Erhöhung von " & " " & .Cells(10 + TabNumber, 1) & _
        " wirklich übernommen werden?", vbYesNo) = vbYes Then
        .Range("R3") = .Range("Y2")
        .Cells(10 + TabNumber, 7) = objWs.Range("E20")
        ma1ü
        objWs.Range("J14") = 0
      Else
        objWs.Range("J14") = 0
      End If
    End If
    If .Cells(10 + TabNumber, 15) = 1 Then
      If MsgBox("Bitte bestätigen Sie die Aktualisierung von" & " " & _
        .Cells(10 + TabNumber, 1), vbYesNo) = vbYes Then
        .Cells(10 + TabNumber, 18) = .Cells(10 + TabNumber, 10)
        .Range("R3") = .Range("Y2")
        ma1ü
        .Cells(10 + TabNumber, 7) = ""
      Else
        .Cells(10 + TabNumber, 7) = ""
      End If
    End If
  End With
  
  Set objWs = Nothing
End Sub

Sub aufruf()
  Dim lngIndex As Long
  
  For lngIndex = 1 To 100
    MAgeez lngIndex
  Next
  
End Sub

Aber bevor du das Makro "aufruf" anwendest, muss auch der Code von "maXü" bearbeitet werden
Gruß Sepp

Anzeige
und noch einige weitere Fragen...
13.03.2009 20:39:49
Renee
Werner,
Wieviele Makros sind es wirklich ? Sepp gibt dir ein Beispiel mit 100, du hast schon mal 150 genannt!
Willst du bei jedem einzelnen der 150 eine Abfrage, oder genügt eine für alle?
Hast du den Fortschrittsbalken eingebaut oder hast du davon abgesehen ?
Poste bitte den Code zu ma1ü und ma150ü oder was auch immer dein letztes ma...ü ist.
GreetZ Renée
AW: Hallo Renee, hallo Sepp
13.03.2009 20:55:21
werner
Hallo Sepp,
der Code von ma1ü lautet 

Sub ma1ü()  'Abteilung 1
Range("AD11").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Tabelle1").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Gehälter").Select
Application.CutCopyMode = False
Range("R11:T11").Select
Selection.ClearContents
Range("W11:Y11").Select
Selection.ClearContents
Range("F6").Select
End Sub


Was müßte ich da ändern?
Gruß Werner

Anzeige
AW: Hallo Renee, hallo Sepp
13.03.2009 21:05:24
Josef
Hallo Werner,
auf welche Tabelle bezieht sich "Range("AD11").Select" ?
Gruß Sepp

AW: Hallo Renee, hallo Sepp
13.03.2009 21:20:08
werner
Hallo Sepp,
Range ("AD11") bezieht sich auf Tabelle ("Gehälter"), in der sich das Makro befindet, der Hintergrund ist der, daß die Daten von "Gehälter in die Tabelle1 kopiert werden sollen(das ganze natürlich wieder mit Tabelle2,Tabelle2.......
Gruß Werner
AW: Hallo Renee, hallo Sepp
13.03.2009 21:23:31
Josef
Hallo Werner,
dann dieser Code (maüs sind überflüssig)
Sub MAgeez(ByVal TabNumber As Long)
  Dim objWs As Worksheet
  
  Set objWs = Sheets("Tabelle" & CStr(TabNumber))
  
  With Sheets("Gehälter")
    If .Cells(10 + TabNumber, 14) = 1 Then
      If MsgBox("soll die Erhöhung von " & " " & .Cells(10 + TabNumber, 1) & _
        " wirklich übernommen werden?", vbYesNo) = vbYes Then
        .Range("R3") = .Range("Y2")
        .Cells(10 + TabNumber, 7) = objWs.Range("E20")
        ma1ü
        objWs.Range("J14") = 0
      Else
        objWs.Range("J14") = 0
      End If
    End If
    If .Cells(10 + TabNumber, 15) = 1 Then
      If MsgBox("Bitte bestätigen Sie die Aktualisierung von" & " " & _
        .Cells(10 + TabNumber, 1), vbYesNo) = vbYes Then
        .Cells(10 + TabNumber, 18) = .Cells(10 + TabNumber, 10)
        .Range("R3") = .Range("Y2")
        'ersatz für maüs
        objWs.Range("B5") = .Cells(10 + TabNumber, 30).Value
        .Range(.Cells(10 + TabNumber, 18), .Cells(10 + TabNumber, 20)).ClearContents
        .Range(.Cells(10 + TabNumber, 23), .Cells(10 + TabNumber, 25)).ClearContents
        '
        .Cells(10 + TabNumber, 7) = ""
      Else
        .Cells(10 + TabNumber, 7) = ""
      End If
    End If
  End With
  
  Set objWs = Nothing
End Sub

Ausserdem wäre interessant, wie du das ganze aufrufst, wie Renée schin vermutete, kann man da sicher noch einfacher vorgehen.
Gruß Sepp

Anzeige
AW: Hallo Renee, hallo Sepp
13.03.2009 21:57:55
werner
Hallo Sepp,
ich rufe das ganze mit Private Sub Worksheet_Calculate bzw habe ich es auch mit Worksheet_Activate aufgerufen, wie müßte ich das einbauen?
Gruß Werner
AW: Hallo Renee, hallo Sepp
14.03.2009 08:59:50
Renee
Hi Werner,
Wieso rufst du das in diesen Ereignis-Prozeduren auf?
Wenn du das in Calculate einbaust, kommst du ja praktisch nicht mehr zum Arbeiten.
Kannst du mal das Konzept als Ganzes versuchen zu erklären?
Welche Zellenveränderungen haben z.B. einen solchen Einfluss, dass die Routine ablaufen sollte?
GreetZ Renée
AW: Hallo Renee, hallo Sepp
14.03.2009 20:42:46
werner
Hallo Renee,
ich hatte das ganze vorher benutzt (wo mein Makro Ausgelöst wurde,aber umständlich war) mit dem jetzigen Makro d. h. mit Eurem Vorschlag weis ich ja nicht wie ich es zum Laufen bringen soll. Z.B. Wenn ich das Tabellenblatt öffne soll mit der Berechnung angefangen werden d. h. das Makro soll gestartet werden.
Ich habe es mit
Option Explicit
Sub Worksheet_Open()
MAgeez(ByVal TabNumber As Long)
Dim objWs As Worksheet
Set objWs = Sheets("Tabelle" & CStr(TabNumber))
With Sheets("Gehälter")
. . . . .
. . . . .
so klappt das aber leiter nicht.
Gruß Werner
Anzeige
AW: Hallo Renee, hallo Sepp
14.03.2009 22:06:10
Josef
Hallo Werner,
dazu fällt mir nur das ein.
Zitat von Ramses: Warum müsst ihr es immer mit der Mondlandung versuchen, wenn ihr nicht mal Laufen könnt?
Ein letzter Versuch.
In das Modul "DieseArbeitsmappe" kopierst du diesen Code und passt die Nummeran!
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Open()
  MAgeez 100 'die Anzahl musst du wissen!
End Sub

In ein allgemeines Modul kopierst du diesen Code.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub MAgeez(ByVal TabNumber As Long)
  Dim objWs As Worksheet
  
  Set objWs = Sheets("Tabelle" & CStr(TabNumber))
  
  With Sheets("Gehälter")
    If .Cells(10 + TabNumber, 14) = 1 Then
      If MsgBox("soll die Erhöhung von " & " " & .Cells(10 + TabNumber, 1) & _
        " wirklich übernommen werden?", vbYesNo) = vbYes Then
        .Range("R3") = .Range("Y2")
        .Cells(10 + TabNumber, 7) = objWs.Range("E20")
        ma1ü
        objWs.Range("J14") = 0
      Else
        objWs.Range("J14") = 0
      End If
    End If
    If .Cells(10 + TabNumber, 15) = 1 Then
      If MsgBox("Bitte bestätigen Sie die Aktualisierung von" & " " & _
        .Cells(10 + TabNumber, 1), vbYesNo) = vbYes Then
        .Cells(10 + TabNumber, 18) = .Cells(10 + TabNumber, 10)
        .Range("R3") = .Range("Y2")
        'ersatz für maüs
        objWs.Range("B5") = .Cells(10 + TabNumber, 30).Value
        .Range(.Cells(10 + TabNumber, 18), .Cells(10 + TabNumber, 20)).ClearContents
        .Range(.Cells(10 + TabNumber, 23), .Cells(10 + TabNumber, 25)).ClearContents
        '
        .Cells(10 + TabNumber, 7) = ""
      Else
        .Cells(10 + TabNumber, 7) = ""
      End If
    End If
  End With
  
  Set objWs = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Hallo Renee, hallo Sepp
15.03.2009 13:07:23
werner
Hallo Sepp,
das Zitat finde ich gut und ich Glaube,es trifft auf mich zu, wie ich aber schon geschrieben habe hab ich mich etwas überschätzt und sollte es vielleicht erst mal mit dem "Laufen" versuchen.
Deshalb möchte ich mich nochmals für mein Verhalten entschuldigen, und zu guter letzt nochmals herzlichen Dank für die Hilfe.
Gruß Werner
Zu deiner Erinnerung!
13.03.2009 19:45:58
Renee
Werner,
10.01.2009 22:53:02 : https://www.herber.de/forum/archiv/1036to1040/t1038543.htm
26.01.2009 06:07:01 : https://www.herber.de/forum/archiv/1040to1044/t1043725.htm
26.01.2009 20:58:04 : https://www.herber.de/forum/archiv/1044to1048/t1044021.htm
23.02.2009 22:04:09 : https://www.herber.de/forum/archiv/1052to1056/t1053303.htm
09.03.2009 20:30:23 : https://www.herber.de/forum/archiv/1056to1060/t1058304.htm
Renée
Anzeige

299 Forumthreads zu ähnlichen Themen

Mappe mit variablen Dateinamen aktivieren
Peter

Hallöchen an alle,
wie kann man eine geöffnete Mappe über workbooks.activate oder windows.activate ansprechen, ohne dass man den vollen Dateinamen kennt.
Dateiname = "Auftragskennzahlen(*).xls"
Das * steht für eine Zahl, die mir nicht bekannt ist, sondern von einer Web-Datenbank ver...
07.08.2008 17:27:58
Thread-ID: 1000047
4 Beiträge
Anzeige
Befehlsschaltfläche zum Versenden einer e-Mail
Roland

Hallo. Ich habe eine für mich sehr harte "Nuss" zu knacken. Ich habe über Excel ein Rechnungsprogramm erstellt. jetzt möchte ich diese Rechnung immer per e-mail versenden. Ich brauche eine Befehlsschaltföläche, die einen bestimmten Bereich als e_mail versendet. Also.... Die Schaltfläche sollte...
11.08.2008 13:17:00
Thread-ID: 1000827
2 Beiträge
Nie zweimal gleiche Werte hintereinander (Teil 2)
Kay

Hallo,
Ich hoffe, es kann mir nochmal jemand weiterhelfen.
Am 05.08. um 16.30 Uhr habe ich bereits schon mal einen Thread zu diesem Thema eröffnet, jedoch noch keine abschließende Lösung gefunden.
Mit Hilfe von "Hary" habe ich folgendes Sheet gebaut, welches auch soweit funktioniert...
11.08.2008 16:12:24
Thread-ID: 1000900
8 Beiträge
Anzeige
Tastenkombinaiton Format kopieren
erkoo

Wer kennt die Tastenkombination für Format kopieren und Format einfügen?
Danke erkoo
13.08.2008 16:28:20
Thread-ID: 1001592
3 Beiträge
Formatierung mit Makro läuft nur bei Eingabe
Ulrich

Hallo zusammen,
ich möchte Zellen einfärben, wenn in einer anderen Zelle der Wert "1" steht, und bei "0" wieder weiß - deswegen mit unten stehendem Makro im Tabellenblatt.
Das Problem ist, dass die Werte (0 und 1) per Formel erzeugt werden, und das Makro nur funktioniert, wenn ich tatsä...
14.08.2008 11:34:00
Thread-ID: 1001783
8 Beiträge
Vergleich aus Liste mit Einbindung Minimum/Maximum
Jörg

Hallo liebe Excelfreunde,
ich glaube, ich habe seit gestern einen kleinen Blackout und kann keine Formeln mehr mischen...
Problem: Aus einer Liste mit Werten soll jeweils der Minimum- und Maximumwert (gerundet oder ungerundet) angegeben werden, der als erstes (bei Min) oder letztes (bei...
15.08.2008 14:05:53
Thread-ID: 1002182
4 Beiträge
Vergleich aus Liste mit Einbindung Minimum/Maximum
Jörg

Hallo liebe Excelfreunde,
ich glaube, ich habe seit gestern einen kleinen Blackout und kann keine Formeln mehr mischen...
Problem: Aus einer Liste mit Werten soll jeweils der Minimum- und Maximumwert (gerundet oder ungerundet) angegeben werden, der als erstes (bei Min) oder letztes (bei...
15.08.2008 14:57:54
Thread-ID: 1002190
2 Beiträge
Zeilenmerkmale in Spalten umwandeln
MG_Learning

Hallo zusammen!
Ich habe keine Ahnung, wie ich aus folgender Tabellenstruktur: Beispiel:
A B C
London 20 Kinos
London 50 Gaststätten
London 10 Einkaufscentren
Paris 18...
17.08.2008 18:31:50
Thread-ID: 1002449
4 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
3
4
1
7
2
2
7
3
1
3
2
6
6
11
2
2
3
3
14
1
2
2
4
2
2