Hallo!
Ich habe jetzt überall im Internet und auch in Fachbüchern gesucht, aber komme einfach nicht auf die korrekte Lösung meines Problems. Ich möchte zwei Sub-Prozeduren für verschiedene Tabellenblätter in Excel 2007 ausführen, wenn sich Werte in einem bestimmten Bereich ändern. Die Prozeduren sollen allerdings im Hintergrund ablaufen ohne, dass Excel dabei von Blatt zu Blatt springt. Das geschieht nämlich, wenn man es mit "Makro aufzeichnen" probiert und für jedes Tabellenblatt die beiden Prozeduren händisch ausführt. Mittlerweile frage ich mich, ob das überhaupt möglich ist. Oder ist es so, dass ein Tabellenblatt immer zunächst mit Activate oder Select ausgewählt werden muss bevor damit gerechnet werden kann? Ich würde mich wirklich sehr freuen, wenn mir jemand helfen könnte, da ich niemanden persönlich kenne der VBA programmiert. Die kritischen Anweisungen sind fett gedruckt:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Worksheets("VEP2 Fahrspiel").Range("D2:J15")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
ThisWorkbook.Worksheets("Tabelle3").Application.Run _
"'Beispieldatei.xlsm'!Restbeschleunigung"
ThisWorkbook.Worksheets("Tabelle3").Application.Run _
"'Beispieldatei.xlsm'!Fahrtzeit"
ThisWorkbook.Worksheets("Tabelle4").Application.Run _
"'Beispieldatei.xlsm'!Restbeschleunigung"
ThisWorkbook.Worksheets("Tabelle4").Application.Run _
"'Beispieldatei.xlsm'!Fahrtzeit"
ThisWorkbook.Worksheets("Tabelle5").Application.Run _
"'Beispieldatei.xlsm'!Restbeschleunigung"
ThisWorkbook.Worksheets("Tabelle5").Application.Run _
"'Beispieldatei.xlsm'!Fahrtzeit"
End If
End Sub
Public Sub Restbeschleunigung()
Debug.Print "Restbeschl."
Dim x As Double
x = 2
Do While Cells(x, 3).Value < Cells(10, 19).Value
x = x + 1
If x > 10003 Then Exit Do
Loop
If x < 10003 Then
Cells(31, 17).Value = Round(Cells(x - 1, 6), 2)
Else
Cells(31, 17).Value = 0
End If
End Sub
Public Sub Fahrtzeit()
Dim x As Double
x = 3
Do While Cells(x, 3).Value <> 0
x = x + 1
Loop
Cells(32, 17).Value = Cells(x, 1)
End Sub
|