Makro mehrfach aufrufen mit Namensübergabe

[Rabe]

Hallo,

ich habe vor 5 Jahren ein laaanges Makro erstellt für die Auswertung eines Protokolls durch farbenzählen und
Darstellung der Anzahl pro Farbe in der Auswertungsstabelle "Auswertung 1".

Das Makro heißt "Statistik()" und wird so aufgerufen:
Druck auf Commandbutton im Protokoll, der zeigt eine Userform mit Fortschrittsbalken an und startet das Makro "Statistik()".

Ich lasse die Farben zählen, übertrage die relevanten Zahlen in ein Array und schreibe die Array-Inhalte in die Auswertungstabelle in definierte Zellen für den aktuellen Monat.

Code:

Worksheets("Auswertung 1").Cells(3, col).Value = varFeld(0, 0)

Das funktioniert soweit ganz gut.

Nun sind das aber jetzt 8 + 5, also 13 Protokolle geworden, die in einer Gesamtauswertung zusammengefaßt dargestellt werden sollen. Dazu würde ich die 13 Protokolle in 13 Auswertungen darstellen und dann alle Auswertungen auf die Gesamtauswertung verlinken.

Ich hatte es mir so gedacht:
ich übergebe bei Buttondruck dem Makro die jeweilige Protokoll- und Auswertungs-Namenskombination, aktiviere das Protokoll, ersetze dabei in der obigen Formel das "Auswertung 1" durch den jeweiligen Namen und lasse die Zahlen in die Auswertung eintragen, dann startet das Makro mit der zweiten Namenskombination wieder und das geht insgesamt 13 mal so.

Wird dazu das Makro so aufgerufen?
Definition:
Sub Statistik(Protokoll as String, Auswertung as String)

Aufruf:
Call Statistik(Protokoll1, Auswertung1)
Call Statistik(Protokoll2, Auswertung2)
...
Geht das so?

Wie kann ich in der obigen Formel den Namen ersetzen, so daß er zum Protokoll passt?

[Kuwer]

Hallo Ralf,

sollte eigentlich so wie Du schreibst gehen.

Code:

Worksheets(Auswertung).Cells(3, col).Value = varFeld(0, 0)

Gruß Uwe

[Rabe]

Hi Uwe,

sollte eigentlich so wie Du schreibst gehen.

ja, so geht es.

Nun zu dem Folgeproblem.

Ich rufe einen Fortschrittsbalken mit diesem Code auf:

Code:

Option Explicit
'**************************************************
'* 27.02.2009                                                                             *
'* erstellt von RaBe                                                                    *
'*                                                                                                *
'**************************************************

Private Sub CommandButton1_Click()
   Dim t As Single
   Dim Mldg, Stil, Titel, Hilfe, Ktxt, Antwort, Text1
  
   t = Timer
  
   CommandButton1.Caption = "Berechnung läuft!"
   PB1.Show                                         ' Anzeige des Fortschrittbalkens
   CommandButton1.Caption = "Neuberechnung"
  
   Mldg = Timer - t                                 ' Meldung definieren.
   Titel = "Laufzeit des Makros"                    ' Titel definieren.
'   Antwort = MsgBox(Mldg & " Sek.", , Titel)                  ' Meldung anzeigen.
  
End Sub

dies ist der Code des Balkens (= Userform):

Code:

Option Explicit

Private Sub UserForm_Activate()
   SW = 0
   Label2.Width = 0
   Call Statistik("H2-Tank System", "Auswertung Tanksystem")          ' Aufruf der Statistik-Funktion
End Sub

Und dann kommt das Statistik-Modul in einem allgemeinen Modul:

Code:

Option Explicit
'**************************************************
'* 27.02.2009                                                                             *
'* erstellt von RaBe                                                                    *
'* erstellt Statistik über Tests sowie Diagramme                       *
'**************************************************

Public SW As Long
Dim Schritt As Double, Schritt1 As Double
Dim Länge As Double
Dim k As Long

Sub Statistik(Protokoll As String, Auswertung As String)
   ' Definition der Variablen
   Dim Zelle, z%, a, b%, c1, c2, c3, c4, i%, j%, red As Integer
   Dim SummeGrau%, SummeWeiss%, SummeWeissS%, SummeBlau%, SummeTuerkis%, SummeLavendel%, SummeGelb%
   Dim SummeGruen%, SummeGruenW%, SummeGruenS%, GesamtsummeGruen%
   Dim SummeRot%, SummeRotW%, SummeRotS%, GesamtsummeRot%
   Dim Mon%, col%
  
   Dim varFeld(2, 9) As Double
   Dim intB As Integer
   Dim S1 As String
   Dim S2 As String
   Dim Ist As String
  
   ' Bedeutung der Farben
'     Grau, 15, Schraffiert, Prüfung nicht geplant      ' Farbname, Farbnummer, Bedeutung der Farbe
'     Blassblau , 37, Prüfung geplant
'     Türkis , 8, Prüfung wird durchgeführt
'     Lavendel , 39, Prüfung abgeschlossen, Bewertung fehlt
'     Gelb , 6, Prüfung abgeschlossen, Abweichendes Ergebnis
'     Grün , 4, Prüfung bestanden
'     Rot , 3, Prüfung nicht bestanden
'     Rot , 3, W, Prüfung nach Wiederholung nicht bestanden
'     Grün , 4, W, Prüfung nach Wiederholung bestanden
  
   ' Löschen der Farbzähl-Variablen beim Start
   SummeGruen = 0
   SummeGruenW = 0
   SummeGruenS = 0
   GesamtsummeGruen = 0
   SummeGelb = 0
   SummeRot = 0
   SummeRotW = 0
   SummeRotS = 0
   SummeGrau = 0
   SummeWeiss = 0
   SummeWeissS = 0
   SummeBlau = 0
   SummeTuerkis = 0
   SummeLavendel = 0
  
   ' Definition des Array für die Auswertung und Diagramme (2x 6 =) 12 Test-Arten
   For i = 0 To 5
      For j = 0 To 2
         varFeld(j, i) = 0
      Next j
   Next i
  
   Mon = 0
   col = 0
  
   Application.ScreenUpdating = False                              ' speed up the macro durch ausschalten der stänbdigen Bildschirmaktualisierung
  
   Worksheets(Protokoll).Activate
  
   ' ########################              Code für Fortschrittsanzeige
   k = 0
   ' Anpassen an maximal benutzten Bereich über alle Übersichten!
   SW = Range("L7:HR32").Cells.Count               ' Gesamtlaufzeit festlegen über Zählbereich
   Länge = 0
   Schritt = PB1.Label1.Width / SW                 ' Schrittbreite pro Aktualisierung
   ' ########################              Code für Fortschrittsanzeige
  
   ' Bereich analog oben anpassen!
   For Each Zelle In Range("L7:HR32")           ' Tabellenbereich, der überprüft wird.
  
   ' ########################              Code für Fortschrittsanzeige
      k = k + 1
      Länge = Länge + Schritt
      PB1.Label2.Width = Länge
      PB1.Label3.Caption = Format(k / SW, "0 %")
      DoEvents
   ' ########################              Code für Fortschrittsanzeige
      
      a = Zelle.Column
      b = Range(Cells(2, a), Cells(2, a)).Interior.ColorIndex
      
   ' ########################              Zählen der Farben
      If b = 34 Then
         Select Case Zelle.Interior.ColorIndex
            Case 2, Is < 0                                         ' Farbe Weiss oder so
               If Zelle.Interior.Pattern = xlLightUp Then
                  SummeWeissS = SummeWeissS + 1
               Else
                  SummeWeiss = SummeWeiss + 1
               End If
            Case 3                                                 ' Farbe Rot, abgeschlossen, Prüfung nicht bestanden
               SummeRotS = SummeRotS + 1
               If Zelle.Interior.Pattern <> xlUp Then
                  If Right(Zelle.Value, 1) = "W" Then              ' Prüfung nach Wiederholung nicht bestanden
                     SummeRotW = SummeRotW + 1
                  Else
                     SummeRot = SummeRot + 1
                  End If
               End If
            Case 4                                                 ' Farbe Grün, abgeschlossen, bestanden
               SummeGruenS = SummeGruenS + 1
               GesamtsummeGruen = GesamtsummeGruen + 1
               If Zelle.Interior.Pattern <> xlUp Then
                  If Right(Zelle.Value, 1) = "W" Then
                     SummeGruenW = SummeGruenW + 1
                  Else
                     SummeGruen = SummeGruen + 1
                  End If
               End If
            Case 6                                                 ' Farbe Gelb, Prüfung abgeschlossen, Abweichendes Ergebnis
               SummeGelb = SummeGelb + 1
            Case 15                                                ' Farbe Grau, Prüfung nicht geplant
               SummeGrau = SummeGrau + 1
            Case 37                                                ' Farbe Blau, Test geplant
               SummeBlau = SummeBlau + 1
            Case 8                                                 ' Türkis, 8, Prüfung wird durchgeführt
               SummeTuerkis = SummeTuerkis + 1
            Case 39                                                ' Lavendel, Prüfung abgeschlossen, Bewertung fehlt
               SummeLavendel = SummeLavendel + 1
         End Select
      End If
      
      ' hier wird geprüft, ob manche Tests nur für manche Requirement-Vorschriften benötigt werden!
      Set c1 = Cells(3, Zelle.Column).Find("SDR", LookIn:=xlValues, LookAt:=xlPart)
      Set c2 = Cells(3, Zelle.Column).Find("BDVR", LookIn:=xlValues, LookAt:=xlPart)
      Set c3 = Cells(2, Zelle.Column).Find("Package drop", LookIn:=xlValues, LookAt:=xlPart)
      Set c4 = Cells(2, Zelle.Column).Find("Handling Drop", LookIn:=xlValues, LookAt:=xlPart)
      
      ' wenn in Zeile 3 nirgends etwas drin steht, dann ist variable red mit 1 gefüllt
      If ((c1 Is Nothing) And (Not c2 Is Nothing)) Or (Not c3 Is Nothing) Or (Not c4 Is Nothing) Then
         red = 1
      Else
         red = 0
      End If
      
      Select Case Zelle.Interior.ColorIndex                             ' Zuweisung der Test-Art zu Variable intB
      Case 3, 4, 6, 37, 39
         Select Case Cells(4, Zelle.Column)                             ' Welcher Begriff steht in Zeile 4?
         Case "Functional"
            intB = 0
         Case "Climatic"
            intB = 1
         Case "Mechanical"
            intB = 2
         Case "Corrosion"
            intB = 3
         Case "Electrical"
            intB = 4
         Case "IP"
            intB = 5
         Case "Endurance"
            intB = 6
         Case "Additional"
            intB = 7
         Case "Chemical"
            intB = 8
         Case "Safety"
            intB = 9
         Case Else                          ' falls etwas anderes oder nichts in Zelle steht!
            intB = 99
      End Select
      
      ' Übergabe der Zahlen an ein Array für die Test-Art
      If intB < 99 Then
         varFeld(0, intB) = varFeld(0, intB) + 1
         If (Zelle.Interior.ColorIndex = 37) And (red > 0) Then         ' Farbe Blau, Test geplant, Requirement
            varFeld(1, intB) = varFeld(1, intB) + 1
         ElseIf (Zelle.Interior.ColorIndex = 4) Then                    ' Farbe Grün, abgeschlossen, bestanden
            varFeld(2, intB) = varFeld(2, intB) + 1
         ElseIf (Zelle.Interior.ColorIndex = 8) Then                    ' Türkis , 8, Prüfung wird durchgeführt
            varFeld(2, intB) = varFeld(2, intB) + 0.5
         End If
      End If
   End Select
  
   Next Zelle
  
   ' Definition der Spalten für den Eintrag der Monatszahlen
   Select Case Cells(1, "D").Value
   Case "Mai 2014"
      Mon = 0
   Case "Juni 2014"
      Mon = 1
   Case "Juli 2014"
      Mon = 2
   Case "August 2014"
      Mon = 3
   Case "September 2014"
      Mon = 4
   Case "Oktober 2014"
      Mon = 5
   Case "November 2014"
      Mon = 6
   Case "Dezember 2014"
      Mon = 7
   Case "Januar 2015"
      Mon = 8
   Case "Februar 2015"
      Mon = 9
   Case "März 2015"
      Mon = 10
   Case "April 2015"
      Mon = 11
   Case "Mai 2015"
      Mon = 12
   Case "Juni 2015"
      Mon = 13
   Case "Juli 2015"
      Mon = 14
   Case "August 2015"
      Mon = 15
   Case "September 2015"
      Mon = 16
   Case "Oktober 2015"
      Mon = 17
   Case "November 2015"
      Mon = 18
   Case "Dezember 2015"
      Mon = 19
   Case "Januar 2016"
      Mon = 20
   Case "Februar 2016"
      Mon = 21
   Case "März 2016"
      Mon = 22
   Case "April 2016"
      Mon = 23
   Case "Mai 2016"
      Mon = 24
   Case "Juni 2016"
      Mon = 25
      ' Case <== hier weitere Bedingungen
   End Select
  
   col = Mon + 4                    ' 4 + 12 + Mon - 10
  
  
   ' Monats-Status der Testzahlen übertragen
   Worksheets(Auswertung).Cells(3, col).Value = varFeld(0, 0)
   Worksheets(Auswertung).Cells(4, col).Value = varFeld(2, 0)
  
   Worksheets(Auswertung).Cells(5, col).Value = varFeld(0, 1)
   Worksheets(Auswertung).Cells(6, col).Value = varFeld(2, 1)
  
   Worksheets(Auswertung).Cells(7, col).Value = varFeld(0, 2)
   Worksheets(Auswertung).Cells(8, col).Value = varFeld(2, 2)
  
   Worksheets(Auswertung).Cells(9, col).Value = varFeld(0, 3)
   Worksheets(Auswertung).Cells(10, col).Value = varFeld(2, 3)
  
   Worksheets(Auswertung).Cells(11, col).Value = varFeld(0, 4)
   Worksheets(Auswertung).Cells(12, col).Value = varFeld(2, 4)
  
   Worksheets(Auswertung).Cells(13, col).Value = varFeld(0, 5)
   Worksheets(Auswertung).Cells(14, col).Value = varFeld(2, 5)
  
   Worksheets(Auswertung).Cells(15, col).Value = varFeld(0, 6)
   Worksheets(Auswertung).Cells(16, col).Value = varFeld(2, 6)
  
   Worksheets(Auswertung).Cells(17, col).Value = varFeld(0, 7)
   Worksheets(Auswertung).Cells(18, col).Value = varFeld(2, 7)
  
   Worksheets(Auswertung).Cells(19, col).Value = varFeld(0, 8)
   Worksheets(Auswertung).Cells(20, col).Value = varFeld(2, 8)
  
   Worksheets(Auswertung).Cells(21, col).Value = varFeld(0, 9)
   Worksheets(Auswertung).Cells(22, col).Value = varFeld(2, 9)
  
   Application.ScreenUpdating = True
  
   Call Datum_setzen
  
   Worksheets(Auswertung).Activate
  
   ' ########################              Code für Fortschrittsanzeige
   ' Application.Wait (Now + TimeValue("0:00:1"))
   Unload PB1
   ' ########################              Code für Fortschrittsanzeige

End Sub

Wie kann ich nun 8 oder 13 mal den Fortschrittsbalken aufrufen und dabei jeweils das Protokoll/Auswertungs-Namenspaar an das Statistikmodul übergeben?

[Kuwer]

Hallo Ralf,

Du hast es doch im 1. Post schon geschrieben.
Im Activate einfach die 8 oder 13 Calls untereinander schreiben.

Gruß Uwe

[Rabe]

Du hast es doch im 1. Post schon geschrieben.
Im Activate einfach die 8 oder 13 Calls untereinander schreiben.

das hatte ich heute nachmittag ausprobiert, aber dabei ist mir Excel komplett abgeschmiert.
War vielleicht aufgrund anderer Sachen abgestürzt, aber ich hatte vorher nicht gespeichert, drum war das etwas doof und ich habe die Lust verloren.

Ich teste es gleich wieder.
Andererseits startet dabei doch die Userform nicht nochmal, das heißt, der Fortschrittsbalken läuft nicht wieder los. Oder doch?

[päter]
Ok, jetzt habe ich es getestet: Das läuft mehrmals, aber der Fortschrittsbalken läuft natürlich leider nur ein Mal.

[Kuwer]

Hallo Ralf,

hast Du keine Beispieldatei?

Gruß Uwe

[Rabe]

Hi Uwe,

hast Du keine Beispieldatei?

ich versuche am Wochenende mal, eine zu basteln.

[Rabe]

hast Du keine Beispieldatei?

So, hier ist nun die [
Dateiupload bitte im Forum! So geht es: Klick mich!
].

Beim Start auf den Button werden nacheinander in den Übersichten die Farben gezählt und über das Array in die Auswertung eingetragen.

Bei der ersten Übersicht läuft der Fortschrittsbalken ab, da dann aber gleich das zweite Mal das Statistik-Makro aufgerufen wird, startet ja der Fortschrittsbalken nicht nochmal.

Ich hätte gerne, daß

1. jedesmal der Balken abläuft
   
2. ich vorher (z.B. in einem Userform) auswählen kann, welche Übersichten alles ausgewertet werden sollen
   

Wie könnte so etwas zu lösen sein?

[schauan]

Hallo Ralf,

nimm das Unload Me aus dem Statistikprogramm und setze es ans Ende vom Userform_Activate.

Damit der user sieht, was gerade berechnet wird, kannst Du im userform vor jedem Call die Caption ändern, z.B. Me.Caption="Berechne Statistik 1" usw.

[Rabe]

Hi André,

nimm das Unload Me aus dem Statistikprogramm und setze es ans Ende vom Userform_Activate.

Damit der user sieht, was gerade berechnet wird, kannst Du im userform vor jedem Call die Caption ändern, z.B. Me.Caption="Berechne Statistik 1" usw.

so sieht das schon mal gut aus (siehe die Datei in der Dropbox).

Jetzt wäre nur noch ein Menü der Übersichten toll, in der ausgewählt werden kann, welche alles statistifiziert werden sollen.
Vielleicht ist das auch eine Idee, das auf der Start-Seite anzuklicken und dann irgendwie in die Userform_Activate zu übernehmen?