Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1088to1092
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

Definition eigener Funktionen (ohne Makros!)

Definition eigener Funktionen (ohne Makros!)
Hauke
Moin moin!
Ich muss eine größere Tabelle pflegen, die etwa so aufgebaut ist:

Datum     Abteilung   A             B            C            D                   E           F
Jan 09    Abt. 1      100 €                      500 €                            1
Jan 09    Abt. 2      200 €                      400 €                            2
Jan 09    Abt. 3      300 €                      300 €                            3
Jan 09    Abt. 4      400 €                      200 €                            4
Feb 09    Abt. 1      100 €                      500 €                            1
Feb 09    Abt. 2      200 €                      400 €                            2
Feb 09    Abt. 3      300 €                      300 €                            3
Feb 09    Abt. 4      400 €                      200 €                            4

A und C enthalten bestimmte von Hand eingegebene Werte. B soll nun ab Dezember 09 die Summe der Werte aus A der letzten 12 Monate für eine Abteilung ausweisen. Vorher soll da halt noch nichts drin stehen. Das gleiche gilt auch für D (mit den Werten aus C). ==> Dafür verwende ich das selbstgeschriebene Makro "SUMME12MONATE".
E könnte man "Jahresendziel" nennen. In F wird dann zwischen dem Wert für eine Abteilung aus dem letzten Dezember und dem Jahresendziel für einen Monat linear berechnet. ==> Dafür verwende ich das selbstgeschriebene Makro "ZIELKALKULATION".
Die Makros sehen so aus:

Option Explicit
'Die Anzahl an Zeilen, die die Spaltenüberschriften benötigen
Public Const HeaderRowCount As Long = 1
' Die Anzahl an Zeilen, die ein Monatsblock hat ==> Anzahl der Abteilungen
Public Const BlockRowCount As Long = 4
Public Function SUMME12MONATE(Zelle As Range) As Variant
SUMME12MONATE = ""
' Teste, ob die Zelle bereits ein Jahr vorherige Daten hat...
If Zelle.Row > BlockRowCount * 12 + HeaderRowCount Then
' Wenn das der Fall ist, summiere die Daten der letzten 12 Monate auf.
SUMME12MONATE = CCur(0)
Dim I As Long
For I = 0 To 11
SUMME12MONATE = SUMME12MONATE + CCur(Cells(Zelle.Row - I * BlockRowCount, Zelle. _
Column))
Next
End If
End Function
Public Function ZIELKALKULATION(Datumszelle As Range, Jahresendzielzelle As Range) As Variant
'Entspricht ungefähr =INDIREKT("Z"&zeileletzterdezember&"S"&SPALTE(AI49);FALSCH)+(INDIREKT("Z"&( _
_
'#BEZUG!+20*12)&"S"&SPALTE(AI49);FALSCH)-INDIREKT("Z"BEZUG!&"S"&SPALTE(AI49);FALSCH))*
'(MONAT($A49)/12)
'...wobei zeileletzterdezember für die Zeilennummer steht, in der die Daten aus dem letzten  _
Dezember für eine Abteilung stehen.
ZIELKALKULATION = ""
' Teste, ob die Zelle bereits ein Jahr vorherige Daten hat...
If Jahresendzielzelle.Row > BlockRowCount * 12 + HeaderRowCount Then
' Ermittle Position der Zelle vom letzten Dezember
Dim lastYearRow As Long
lastYearRow = Jahresendzielzelle.Row - BlockRowCount * Month(Datumszelle)
Dim lastYearTarget As Double
lastYearTarget = Cells(lastYearRow, Jahresendzielzelle.Column)
Dim nextYearTarget As Double
nextYearTarget = Jahresendzielzelle
ZIELKALKULATION = lastYearTarget + (nextYearTarget - lastYearTarget) * Month( _
Datumszelle) / 12
End If
End Function

Das funktioniert beides auch wunderbar, da jedoch meine Tabelle halt sehr viele Einträge enthält, dauert die Neuberechnung aller Zellen (die z.B. beim Einsatz von Autofiltern über Abteilungen von Excel schon recht häufig angestoßen wird) sehr lange.
Um die Lesbarkeit der Tabelle zu erhöhen und - was auch sehr wichtig ist - die Möglichkeit, problemlos Monatsblöcke per Kopieren/Einfügen am unteren Rand anzufügen, hatte ich die Idee, meine Makros mit Excel-Funktionen (ohne VBA) nachzubilden, diese jedoch irgendwie woanders zu definieren. Also so, dass in den Zellen tatsächlich weiter =ZIELKALKULATION(A49;AK49) statt sowas wie =INDIREKT("Z"&zeileletzterdezember&"S"&SPALTE(AI49);FALSCH)+(INDIREKT("Z"&(#BEZUG!+20*12)&"S"&SPALTE(AI49);FALSCH)-INDIREKT("Z"BEZUG!&"S"&SPALTE(AI49);FALSCH))*(MONAT($A49)/12) drin steht.
Hat jemand Tipps, wie ich so etwas umsetzen kann oder alternativ die Performance meiner VBA-Makros verbessern kann?
Vielen Dank für Antworten bereits im Voraus und viele Grüße aus dem hohen Norden! :-)
Hauke

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Definition eigener Funktionen (ohne Makros!)
16.07.2009 16:27:20
Wolli
Hallo Hauke,
wenn Du theoretisch die Funktionen auch ohne Programmierung darstellen kannst, müsstest Du eigentlich eine Function schreiben können, die nur Application.WorksheetFunction.... usw. enthält. Vielleicht ist das dann performanter. Weiß ich aber nicht.
Deine Functions sehen soweit doch nicht schlecht aus!? Du könntest die Rückgabe nicht "As Variant" sondern "As Double" oder "As Currency" machen. Vielleicht bringt das eine Millisekunde.
Wenn ich eine ähnliche Aufgabe zu lösen hätte, würde ich mir eine Prozedur schreiben, die auf Knopfdruck die Daten aktualisiert und fest in die Zellen schreibt. Dann ist die Tabelle an sich schnell und es sind keine Horrorformeln zu sehen. Man kann ja die "berechneten" Werte farbig hinterlegen oder sonst wie kennzeichnen, damit der geneigte Betrachter weiß, womit er es zu tun hat.
Ich lasse die Frage mal offen für andere Tipps. Gruß, Wolli
Anzeige
AW: Definition eigener Funktionen (ohne Makros!)
19.07.2009 10:08:30
BoskoBiati
Hallo Hauke,
ich würde hier auf Funktionen verzichten und ein Makro einbauen, was bei Bedarf angestoßen wird. Hier ein Beispiel (2Zeilen Kopf, Spalte A: Monat und Jahr, Spalte B Abteilung als Abt. 1 etc, Spalten C und E Monatswerte, Spalten D und F Summen für 12 Monate). Die Auswertung mit dem Zielwert ist mir noch nicht klar, deswegen fehlt sie.
Option Explicit
Sub SummeMonat()
Dim Sum1Abt(19) As Variant 'Summe für Anzahl Abteilungen: hier 20
Dim Sum2Abt(19) As Variant 'Summe für Anzahl Abteilungen: hier 20
Dim lngCounter As Long  'Zählvariable
Dim lngcounter2 As Long
Dim Startzeile As Long
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim AnzAbt As Long
AnzAbt = 5
loLetzte1 = Cells(Rows.Count, 1).End(xlUp).Row  'bestimme letzte gefüllte Zeile in Spalte A
loLetzte2 = Cells(Rows.Count, 4).End(xlUp).Row  'bestimme letzte gefüllte Zeile in Spalte Summe
If loLetzte2 = loLetzte1 Then
MsgBox "Die Auswertung für diesen Monat ist bereits abgeschlossen", 16, "Achtung"
Exit Sub
End If
If (loLetzte2 - loLetzte1) Mod AnzAbt  0 Then
MsgBox "Es sind nicht alle Abteilungen übergetragen worden", 16, "Achtung"
Exit Sub
End If
For lngCounter = 3 To loLetzte1
If Month(Cells(lngCounter, 1)) = Month(Cells(loLetzte1, 1)) + 1 And Year(Cells(lngCounter,   _
_
1)) = Year(Cells(loLetzte1, 1)) - 1 Then
If (Cells(lngCounter, 2)) = "Abt. 1" Then
Startzeile = lngCounter
Exit For
End If
End If
Next
For lngCounter = Startzeile To loLetzte1 - AnzAbt 'je nach Zahl der Abteilungen
For lngcounter2 = 0 To AnzAbt - 1
Sum1Abt(lngcounter2) = Sum1Abt(lngcounter2) + Cells(lngCounter + lngcounter2, 3)
Sum2Abt(lngcounter2) = Sum1Abt(lngcounter2) + Cells(lngCounter + lngcounter2, 5)
Next
Next
For lngCounter = 0 To AnzAbt - 1
Cells(loLetzte1 - AnzAbt + lngCounter + 1, 4) = Sum1Abt(lngCounter)
Cells(loLetzte1 - AnzAbt + lngCounter + 1, 6) = Sum2Abt(lngCounter)
Next
End Sub
Zum Starten könnte man in "DieseArbeitsmappe" noch eine Tastenkombination zum Starten definieren:
Private Sub Workbook_open()
Application.OnKey "^%(97)", "DeineAuswertung"
end Sub
startet das Makro bei der Kombination Strg+Alt+1 (auf dem Zehnerblock)
Beim Beenden ausschalten:
Private Sub workbook_beforeclose()
Application.OnKey "^%(97)"
end sub
Gruß
Bosko
Anzeige

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige