Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1608to1612
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

Überprüfung/Kontrolle für einen Neuling

Überprüfung/Kontrolle für einen Neuling
23.02.2018 09:23:12
Klaus
Hallo zusammen.
Vorab möchte ich mal ein riesen Lob an alle hier aussprechen. Ihr macht wirklich eine super Arbeit und helft jedem, der sich(noch) nicht so auskennt wie ihr.
Ich habe vor etwa einem Monat angefangen, ein wenig mit Excel zu probieren. Erst mit Formeln, Formatierungen usw. und dann mit Makros/VBA.
Ich habe hier im Forum oft nach Tips gesucht, um meine Vorstellungen umzusetzen. Immer fand ich einen Code oder ein Schnipzel, mit dem ich arbeiten konnte.
Jetzt habe ich mein Projekt ziemlich gut hinbekommen, wie ich finde und es geht an die Feinheiten. Es wäre super, wenn sich jemand von euch die Zeit nehmen würde, un sich meine Makros mal anschauet. Vlt. kann man ja noch etwas ändern oder verbessern. Derzeit ist die Originaldatei etwa 600Kb groß und wird anscheinend durch einge Makros beim Start und Beenden stark ausgebremst. Es dauert ziemlich lange, bis die Excel geöffnet/geschlossen ist.
Aber gut, ich fang mal mit meinen Makros an:
  • 
    Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim i As Long
    For i = 1 To Sheets.Count
    Sheets("Info").Select
    If Environ("username") = "Büro1" Or Environ("username") = "Büro2" Then
    Worksheets("Überblick").Visible = xlSheetVisible
    Sheets(i).Unprotect "1234"
    End If
    Next
    Application.ScreenUpdating = True
    End Sub
    

  • Anforderung bei Workbook_Open():
    Die Datei wird nur von mir und meinem Kollegen bearbeitet aber von mehreren Mitarbeitern genutzt. Natürlich sollen nur ich und mein Kollege (Büro1, Büro2) die Tabellen ändern können. Deshalb die Abfrage des Users. Bei allen anderen Mitarbeitern wird bei Workbook_BeforClose (siehe weiter unten) ein Blattschutz aktiviert und das Blatt "Überblick" ausgeblendet.
    Da ich fast täglich mit der Tabelle arbeite nervt es ziemlich, dass der Start/das Beenden so lange dauern. Die Mitarbeiter schauen eher selten (1-2x pro Woche) in die Tabelle.
    Ich habe schon überlegt, mit einem "If Not" bei der Userabfrage zu arbeiten, bekomme es aber nicht hin...
  • 
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ErsteZeile As Long
    If Target.Count > 1 Then Exit Sub
    If Sh.Name = "Überblick" Then Exit Sub
    If Intersect(Target, Sh.Range("A1:T41")) Is Nothing Then Exit Sub
    With Sheets("Überblick")
    ErsteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(1) = Sh.Name
    .Cells(2) = Target.Address(0, 0)
    .Cells(7) = Target.Value
    .Cells(13) = Date
    .Cells(19) = Time
    End With
    End Sub
    

  • Mit diesem Makro möchte ich eigentlich nur ein Feedback haben, wann, wo, was geändert wurde. Mich stört hier allerdings, dass ich die Ausgabe zwar nach links und rechts verschieben kann (.Cells(1), .Cells(2), .Cells(7), ...) aber nicht nach unten. Ich habe schon versucht, an dem .Row etas zu ändern. Erfolglos...
    Derzeit schreibt das Makro die Ausgabe ja in das Blatt "Überblick". Da ich aber möchte, dass die Mitarbeiter eine etwaige Änderung im 1. Tabellenblatt sehen wäre es super, wenn die Ausgabe auch dort erfolgt. Im 1. Tabellenblatt soll die Ausgabe aber nicht in Zeile 1 sondern in Zeile 25 stehen. (das bekomme ich aber einfach nicht hin -.-)
  • 
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.ScreenUpdating = False
    If Environ("username") = "Büro1" Or Environ("username") = "Büro2" Then
    With Application
    .EnableEvents = False
    .DisplayAlerts = False
    ThisWorkbook.SaveCopyAs "C:\" & "Jsp-Log Backup Test" & ".xlsm"
    .DisplayAlerts = True
    .EnableEvents = True
    End With
    End If
    Dim i As Long
    For i = 1 To Sheets.Count
    Sheets(i).Protect "1234"
    Next
    Worksheets("Überblick").Visible = xlSheetVeryHidden
    If Not Saved Then Save
    Application.ScreenUpdating = True
    End Sub
    

  • Und zum Schluss mein Workbook_BeforeClose.
    Hier funktioniert soweit alles. Wenn im Workbook_Open jedoch die Userabfrage geändert wird muss hier sicherlich auch etwas geändert werden. Dann könnte ja z.B. das "Protect" und das "Visible" wegfallen bzw deaktiviert werden oder?
    Ich habe noch ein Modul. Hier sind aber nur die Funtionen der Buttons hinterlegt. Nichts spannendes also.
    Zu erwähnen ist vlt noch, dass es sich um einen Jahresschichtplan für die Abteilung Logistik handelt. 14 Mitarbeiter, keine große Sache. Ich hoffe, das wenigstens die Formeln stimmen, die ich eingetragen habe. Hierbei bin ich aber ersteinmal zufrieden mit dem, wie es ist...
    (Ich versuche irgendwie eine abgespeckte Arbeitsmappe hier hochzuladen, damit ihr euch diese vlt. mal anschauen könnt. Leider gehen hier ja nur 300Kb)
    Vielen Dank im Vorraus und Sorry, wenn der Beitrag "etwas" länger ist ;-)
    https://www.herber.de/bbs/user/120018.xlsm

    10
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Überprüfung/Kontrolle für einen Neuling
    23.02.2018 10:02:53
    UweD
    Hallo
    Beim open habe ich die Reihenfolge ein wenig verändert.
  • Sheets("Info").Select und
  • Worksheets("Überblick").Visible = xlSheetVisible
    muss nur einmal ausgeführt werden und nicht jedesmal in der Schleife
    Private Sub Workbook_Open()
        Sheets("Info").Select
        Application.ScreenUpdating = False
        Dim i As Long
        Select Case Environ("username")
            Case "Büro1", "Büro2"
                Worksheets("Überblick").Visible = xlSheetVisible
                For i = 1 To Sheets.Count
                    Sheets(i).Unprotect "1234"
                Next
             Case Else
                'Nichts 
          End Select
    End Sub
    
    LG UweD
  • Anzeige
    AW: links?
    23.02.2018 10:07:40
    Fennek
    Hallo,
    zuerst einmal Gratulation, die Code sehen sehr gut aus.
    Die Dateigröße (600 kB) wird nicht die Ursache für eine lange Ladsdauer sein. Da ich die Datei mit de-aktivierten Makros geöffent habe, kann ich nur vermuten:
    In allen Blättern ab N23 sehe ich "#Ref!" und vermute, dass links auf andere Dateien gesetzt sind. Falls das so ist, wird der update recht lange dauern.
    Alle sheets sichtbar/unsichtbar zu setzen bzw ein Password zu setzen oder aufzuheben, geht sehr schnell.
    mfg
    AW:
    23.02.2018 10:40:25
    Klaus
    Hallo.
    Das ging ja mal (wie nicht anders erwartet) ziemlich schnell.
    Vielen Dank für eure Antworten.
    @UweD
    Hab deine Verbesserung gleich mal eingebaut und angepasst. Der Code sieht 1. richtig gut und kompakt aus und funktioniert 2. auch super.
    Das öffnen der Datei, wenn man nicht Büro1 oder Büro2 ist geht bedeutend schneller. Wenn man einer der User ist dauert es immernoch etwas lange. Das wird aber sicher daran liegen, dass der Blattschutz bei 55 Arbeitsblättern aufgehoben werden muss. Die Verzögerung ist aber zu verkraft :)
    Das mit der Schleife ist (im Nachhinein) natürlich logisch. Ist mir nur nicht aufgefallen, da ich den Blick für soetwas noch nicht habe. Danke auch für diesen Tip :)
    @Fennek
    Vielen Dank. Habe sehr viel gelesen und "gegoogelt". Auch das probieren verschiedener Sachen hat mich schon viel weitergebracht. Derzeit versuche ich, mir ein bisschen Wissen anzueignen, um einen solchen Code mal irgendwann komplett allein schreiben zu können. (Hab ja bisher eher kopiert und dann nur angepasst)
    In den Zellen stehen eigentlich nur Verweise innerhalb dieser Tabelle, also z.B. sowas ='KW1'!O23
    Ich denke eher nicht, dass das ausbremst.
    Allerdings habe ich in dem Tabellenblatt KW1.2019 in Spalte 2 Zelle 23-40 eine sehr lange Formel stehen. Da hier die Anwesenheit vom ganzen Jahr gezählt werden soll steht da halt drin:
    ='KW1'!L23+'KW 2'!L23+'KW 3'!L23+'KW 4'!L23+'KW 5'!L23+'KW 6'!L23+'KW 7'!L23+'KW 8'!L23+'KW 9'!L23+'KW 10'... usw.. Ob und wie das kürzer geht weiß ich leider nicht.
    Anzeige
    AW: AW:
    23.02.2018 10:51:49
    Robert
    Hallo Klaus,
    wenn ich das richtig sehe, soll Deine lange Formel die Summe der Zellen L23 aus den Tabellenblätter KW1 bis KWx bilden. Unter der Voraussetzung, dass diese Tabellen in Deiner Mappe hintereinander stehen und keine andere Tabelle dazwischen ist, kann man die Formel wie folgt kürzer darstellen =SUMME('KW1:KWx'!L23).
    Gruß
    Robert
    AW: AW:
    23.02.2018 11:12:42
    Klaus
    Hallo Robert.
    Auch dir danke für deinen Tip. Klappt perfekt und bringt sicher etwas Geschwindigkeit :)
    AW: Überprüfung/Kontrolle für einen Neuling
    23.02.2018 11:19:42
    Klaus
    Da UweD ja soetwas kompaktes aus dem Workbook_Open gemacht hat, habe ich das ganze beim Workbook_BeforeClose auch mal angewendet:
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim i As Long
    Select Case Environ("username")
    Case "Büro1", "Büro2"
    With Application
    .EnableEvents = False
    .DisplayAlerts = False
    ThisWorkbook.SaveCopyAs "C:\" & "Jsp-Log Backup Test" & ".xlsm"
    .DisplayAlerts = True
    .EnableEvents = True
    End With
    For i = 1 To Sheets.Count
    Sheets(i).Protect "1234"
    Worksheets("Überblick").Visible = xlSheetVeryHidden
    Next
    Case Else
    End Select
    If Not Saved Then Save
    Application.ScreenUpdating = True
    End Sub
    
    Scheint zu passen. Zumindest gibt es keine Fehlermeldung.
    Sehe ich das richtig, das im Workbook_Open das
    Application.ScreenUpdating = False
    

    reicht und ich es erst im Workbook_BeforeClose wieder auf True setze?
    Anzeige
    AW: Überprüfung/Kontrolle für einen Neuling
    23.02.2018 11:21:41
    UweD
    Screenupdating wird an jedem Makroende automatisch wieder resettet
    AW: Überprüfung/Kontrolle für einen Neuling
    23.02.2018 11:23:36
    Klaus
    Aha.
    merk ich mir ;-)
    dann zu
    23.02.2018 11:56:03
    UweD
    AW: Überprüfung/Kontrolle für einen Neuling
    23.02.2018 11:59:02
    Klaus
    Danke nochmal an alle :)

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige