Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Ein Makro für mehrere Tabellenblätter

Betrifft: Ein Makro für mehrere Tabellenblätter von: Claudi
Geschrieben am: 11.08.2004 14:40:05

Hallo,

mein Problem ist es das ich mehrere tabellenblätter habe, welche alle die gleich Funktion haben nur mit unterschiedlichen Werten. Deshalb würde ich gerne ein und das selbe Makro darüber laufen lassen.

Habe das auch schon probiert aber er macht das ganze immer nur für das erste tabellenblatt und nicht für alle anderen.

Habe es wie folgt probiert

Sub test()
 Call Berechnung("Tab1")
 Call Berechnung("Tab2")
End Sub


Sub Berechnung(TabName as String)
....

Warum funktioniert das nicht, warum aktiviert er immer nur die erste Tabelle und die anderen bleiben außen vor. 

Gruß Claudi


  


Betrifft: AW: Ein Makro für mehrere Tabellenblätter von: geri
Geschrieben am: 11.08.2004 14:45:31

Hallo Claudi

zeig doch mal den Code von Berechnung

es kann dir sicher geholfen werden
gruss geri


  


Betrifft: AW: Ein Makro für mehrere Tabellenblätter von: Claudi
Geschrieben am: 11.08.2004 14:53:02

Sub KorrBerechnung(TabName as String)

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim runterAnzahl As Integer
Dim rechtsAnzahl As Integer
Dim runterAnzahlRendite As Integer
Dim WS5 As Worksheet
Dim Zeitpunkte As Variant
Dim SpaltenId As Integer

Dim SumProd As Double
Dim Summe As Double
Dim s As Double
Dim StandAbw As Double
Dim Varianz As Double
Dim StandAbwKorrel As Double
Dim Korrel As Double
Dim Sum As Double


    'Mappe1 aktivieren
    'Workbooks("Zinsstrukturkurven.xls").Activate
    'Tabelle1 aktivieren
    
    
    SpaltenId = 14
    Zeitpunkte = Array((1 / 12), 0.25, 0.5, 1, 2, 3, 4, 5, 7, 9, 10, 15, 20, 30)
    

    'Gibt die Anzahl der Werte nach unten aus
    runterAnzahl = Range("A8", Range("A8").End(xlDown)).Count
    

    'Berechnen alle Renditen die unter einem Jahr liegen
    For i = 1 To 3 Step 1
        For j = 8 To 257 Step 1
            
            Cells(j, i + 15) = Zeitpunkte(i - 1) * _
            Application.WorksheetFunction.Ln((1 + (Cells(j + 1, i)) / 100) / (1 + (Cells(j, i)) / 100))
            
        Next j
    Next i
    
    'Berechnet alle Renditen die über einem Jahr liegen
    runterAnzahlRendite = Range("P8", Range("P8").End(xlDown)).Count
    For i = 4 To 14 Step 1
        For j = 8 To 257 Step 1
            If Cells(j, i) <> "#N/A The record could not be found" Then
            Cells(j, i + 15) = Zeitpunkte(i - 1) * ((Cells(j + 1, i)) / 100 - (Cells(j, i)) / 100)
            End If
        Next j
    Next i
    
    'Worksheets("Start").Activate
    
    'MsgBox "Aktualisierung der Renditen, Standardabaweichungen und Korrelationen erfolgreich beendet!"
rechtsAnzahl = Range("P8", Range("P8").End(xlToRight)).Count
'Berechnung der Standardabweichung
For i = 16 To rechtsAnzahl + 15 Step 1
        
            For k = 8 To (runterAnzahlRendite + 7) Step 1
    
              s = Summe
              SumProd = (CStr(Cells(k, i)) * CStr(Cells(k, i)))
              Summe = SumProd + s
       
            Next k
            
          Sum = Summe / runterAnzahlRendite
          StandAbw = Sqr(Sum)
          'Summe muss wieder auf Null gesetzt werden, da ansonsten die Summe der vorher
          'ausgeführten Berechnung mit dazu gerechnet würde
          
            
  ' Übergibt die berechneten Werte in das Tabellenblatt
  Cells(3, i + 16) = StandAbw
  
  'Varianz berechnen
  Varianz = Sum
  Cells(4, i + 16) = Varianz
  Summe = 0
    Next i


'Berechnung der Korrelation
For i = 16 To rechtsAnzahl + 15 Step 1
        'Schleife geht auch nach rechts, aber häufiger
        For j = 16 To rechtsAnzahl + 15 Step 1
            'Schleife liest die Zeilen nach unten hin aus und es wird multipliziert
            'und anschließend addiert
            For k = 8 To (runterAnzahlRendite + 7) Step 1
       
              s = Summe
              SumProd = (CStr(Cells(k, i))) * (CStr(Cells(k, j)))
              Summe = SumProd + s
       
            Next k
            
          Sum = Summe / runterAnzahlRendite
          StandAbwKorrel = (CStr(Cells(3, i + 16)) * CStr(Cells(3, j + 16)))
          Korrel = Sum / StandAbwKorrel
          'Summe muss wieder auf Null gesetzt werden, da ansonsten die Summe der vorher
          'ausgeführten Berechnung mit dazu gerechnet würde
          Summe = 0
            
  ' Übergibt die berechneten Werte in das Tabellenblatt
  Cells(j - 8, i + 16) = Korrel
          
    
        Next j
    Next i

End Sub



  


Betrifft: AW: Ein Makro für mehrere Tabellenblätter von: PeterW
Geschrieben am: 11.08.2004 14:47:44

Hallo Claudi,

warum baust du nicht eine Schleife um dein Makro? Mal ein ganz einfaches Beispiel:
Sub Schleife_ueber_alle_Blaetter()
Dim wks As Worksheet
For Each wks In Worksheets
    MsgBox wks.Name
Next
End Sub

Gruß
Peter


  


Betrifft: AW: Ein Makro für mehrere Tabellenblätter von: Claudi
Geschrieben am: 11.08.2004 14:55:10

Ich habe noch andere Tabelleblätter in der Mappe die nicht davon betroffen sind. Da kann ich das ganze nicht mit "For Each" lösen.

Gruß Claudi


  


Betrifft: AW: Ein Makro für mehrere Tabellenblätter von: PeterW
Geschrieben am: 11.08.2004 14:56:43

Hallo Claudi,

gehen täte das schon mit einer einfach If-Bedingung.

Gruß
Peter


  


Betrifft: AW: Ein Makro für mehrere Tabellenblätter von: Claudi
Geschrieben am: 11.08.2004 14:59:15

Du meinst, so dass ich alle anderen Tabellenblätter mit der If-Bedingung ausschließe, ok ich werd das mal probieren.

Danke Gruß Claudi


  


Betrifft: AW: Ein Makro für mehrere Tabellenblätter von: Claudi
Geschrieben am: 11.08.2004 15:16:51

Hi Peter,

es funktioniert mit der If-Bedingung nicht, vielleicht kannst du mir ja mal etwas Code angeben, habe keine Ahnung mehr wie ich das realisieren soll.

Gruß Claudi


  


Betrifft: AW: Ein Makro für mehrere Tabellenblätter von: PeterW
Geschrieben am: 11.08.2004 18:04:29

Hallo Claudi,

mal ein einfaches Beispiel:
Sub mehrere_Blaetter()
Dim wks As Worksheet
Dim arrSheets As Variant
Dim iShCount As Integer
arrSheets = Array("Tabelle1", "Tabelle2", "Tabelle5")
For Each wks In Worksheets
    For iShCount = 0 To UBound(arrSheets)
        If wks.Name = arrSheets(iShCount) Then
            'hier der Code
            'auf richtige Referenzierung achten
            With wks
                MsgBox .Range("A1")
            End With
        End If
    Next
Next
End Sub

Gruß
Peter


 

Beiträge aus den Excel-Beispielen zum Thema "Ein Makro für mehrere Tabellenblätter"