Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
26.04.2024 16:05:28
PivotChart-Stapeldiagramm erstellen
26.04.2024 15:34:42
Überlagernde Textbox-Ansicht
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1080to1084
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1080to1084
1080to1084
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Schleife mit Berechnung

Schleife mit Berechnung
17.06.2009 17:32:12
Christoph
Liebe VBA-Profis!
Ich bin totaler Neuling im VBA-Sektor. Stehe jetzt vor einem Problem, dass ich ohne Euch nicht lösen kann.
Erklärung des angefügten Excel:
Pro Zeile steht in Spalte E ein Wert, der in den Spalten G bis I entweder in absoluten Zahlen ODER in Spalte K bis M in Prozent aufgeteilt wird. Spalte F und J ist jeweils die Summe. Je nachdem, was ausgefüllt wird, soll der andere Bereich PRO ZEILE berechnet und farblich gekennzeichnet werden.
Jetzt habe ich aber das Problem, dass meine Schleife nicht so wirklich funktioniert, d.h. nicht in die Zeile springt oder sich endlos "im Kreis dreht".
Bitte um Eure Hilfe!
Vielen Dank im Vorraus!
LG Christoph
https://www.herber.de/bbs/user/62522.xls

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife mit Berechnung
17.06.2009 19:38:57
Daniel
HI
du hast ein Event-gesteuertes Makro.
dieses Makro wird immer gestartet, wenn ein bestimmtes Ereignis eintritt, daß ist in deinem Fall das Change-Event, dass immer dann läuft, wenn ein Zellwert oder eine Formel geändert wird.
Dies geschieht auch bei einer Änderung durch das Makro selbst, dh. das Makro ruft sich selber auf.
unterbunden werden kann dieses verhalten mit dem Befehl:

Application.EnableEvents = False


nach setzen dieses Befehls werden keine Event-Gesteuerten Makros mehr ausgeführt und das Makro läuft einfach durch, ohne sich in einer Schleife zu verfangen.
am Makroende darfst du allerdings nicht vergessen, mit 


Application.EnableEvents = True

die Events wieder zu aktvieren, sonst bleiben sie auch nach dem Makrolauf ausgeschaltet und dein Excelblatt funktioniert nicht mehr richtig.
Sollte das passieren (bspw durch einen Fehlerabbruch vor dem Befehl), dann musst du die Events wieder von Hand aktivieren, indem du den Befehl im Direktfenster eingibst.
Gruß, Daniel

Anzeige
AW: Schleife mit Berechnung
17.06.2009 19:42:40
ChrisL
Hallo Namensvetter
Habe die Datei angeschaut, aber mir war einiges unklar. Insbesondere in Bezug auf die Berechnung (funktionierte bei mir nicht) und somit verlor ich irgendwie den Zusammenhang mit Einfärben etc.
Vielleicht helfen dir aber folgende Codezeilen. Wollte damit eine Möglichkeit aufzeigen, um die 3 Zeilen in einer Schleife zu durchlaufen und gleichzeitig innerhalb der Zeile die einzelnen Zellen anzusprechen.

Sub t()
Dim iZeile As Long
Dim Bereich1 As Range, Bereich2 As Range
Dim rng As Range
For iZeile = 6 To 8
Set Bereich1 = Range(Cells(iZeile, 7), Cells(iZeile, 9))
Set Bereich2 = Range(Cells(iZeile, 11), Cells(iZeile, 13))
For Each rng In Bereich1
rng = rng.Address
Next rng
For Each rng In Bereich2
rng = rng.Address
Next rng
Next iZeile
End Sub


cu
Chris

Anzeige
AW: Schleife mit Berechnung
19.06.2009 17:49:26
Christoph
Hallo Chris!
Hallo VBA-Experten!
Vielen Dank, hast mir echt einen tollen Tip gegeben. Da wäre aber auch schon das nächste Problem:
Mittlerweile ist jetzt der "richtige" Bericht gebaut, mein zuletzt hochgeladenes Excel war nur zum Testen, auf Grund der Größe. Im "richtigen" Bericht (siehe Anhang - https://www.herber.de/bbs/user/62579.zip
) soll folgendes passieren. Der Betrag pro Zeile in Spalte G soll nun aufgeteilt werden:
Entweder mit Methode 1 (Spalte K zum Ausfüllen) in der 1. Tabelle (Spalten N bis U) mit absoluten Beträgen, dann wird in der 2. Tabelle (X bis AE) automatisch der prozentuelle Anteil errechnet. Nimmt man Methode 2 dann schließt sich die Zeile in Tabelle 1 zur Eingabe und in Tabelle 2 kann die Aufteilung in Prozent erfolgen (dabei automatische Berechnung der absoluten Beträge in Tabelle 1).
Leider lässt die Performance zu wünschen übrig, denn jedes mal, wenn ein neuer Wert eingegeben wird rechnet das Makro auf Grund der Schleife jede einzelne Position durch. Das dauert ganz schön lange bei 266 Zeilen mal 8 Spalten.
Hast Du/habt Ihr vielleicht eine Idee, wie ich das Makro umbauen könnte, zwecks Performance-Optimierung...das z.B. immer nur die eingegebene Zelle in der jeweils anderen Tabelle berechnet wird? Sonst dauert es nämlich ewig, bis ich mit dem Ausfüllen fertig bin! :-)
Vielen Dank, ein schönes Wochenende und liebe Grüße
Christoph
https://www.herber.de/bbs/user/62579.zip
Anzeige
AW: Schleife mit Berechnung
20.06.2009 09:55:20
ChrisL
Hallo Christoph
Wenn du nur die veränderte Zeile bearbeiten willst, dann kannst du statt der Schleife einfach folgendes verwenden: iZeile = Target.Row
Ich habe jetzt mal rumgebastelt, wobei ich die Logik vom Code nicht hinterfragt habe d.h. ich habe einfach nur den bestehenden Code abgekürzt.
Da die Performance jetzt OK ist, habe ich darauf verzichtet den einen Bandwurm auch noch zu kürzen (du musst ja auch noch etwas zu tun haben ;) ggf. müsstest du mit Select Case die 5 verschiedenen Berechnungsarten zu je einem Block zusammenfassen.
cu
Chris

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iZeile As Long
Dim iSpalte1 As Long
Dim Bereich1 As Range, Bereich2 As Range, Bereich3 As Range, Bereich4 As Range, Bereich5 As  _
Range, Bereich6 As Range, Bereich7 As Range, Bereich8 As Range
Dim Bereich9 As Range, Bereich10 As Range, Bereich11 As Range, Bereich12 As Range, Bereich13 As  _
Range, Bereich14 As Range, Bereich15 As Range, Bereich16 As Range
Dim Summe1 As Range, Summe2 As Range
Dim CheckSpalte As Range
Dim rng As Object
Dim Hakerl As Object
On Error GoTo ErrorHandler ' zur Sicherheit, damit EnableEvents auch bei Errors wieder  _
eingeschaltet ist
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
iZeile = Target.Row
Set Bereich1 = Range(Cells(iZeile, 14), Cells(iZeile, 31))
Set Bereich2 = Range(Cells(iZeile, 25), Cells(iZeile, 31))
Set Summe1 = Cells(iZeile, 13)
Set Summe2 = Cells(iZeile, 23)
Set CheckSpalte = Cells(iZeile, 33)
Select Case Cells(iZeile, 11)
Case 2
Bereich1.Interior.ColorIndex = 37#
Bereich2.Interior.ColorIndex = 19#
For Each rng In Bereich1
If rng  0 Then
rng = Application.WorksheetFunction.Product(Cells(iZeile, 7), rng, 100 ^ -1)
Else
rng = ""
End If
Next rng
For Each rng In Bereich2
If rng  0 Then
rng = Application.WorksheetFunction.Product(Cells(iZeile, 7), rng, 100 ^ -1)
Else
rng = ""
End If
Next rng
Case 1
Bereich2.Interior.ColorIndex = 37#
Bereich1.Interior.ColorIndex = 19#
For Each rng In Bereich1
If rng  0 Then
rng = Application.WorksheetFunction.Product(Cells(iZeile, 7) ^ -1, rng, 100)
Else
rng = ""
End If
Next rng
Case Else
Bereich1.Interior.ColorIndex = 37#
Bereich1.Value = ""
Bereich2.Interior.ColorIndex = 37#
Bereich2.Value = ""
MsgBox "please choose method 1 or 2"
End Select
Summe2 = Application.WorksheetFunction.Sum(Bereich2)
Summe2.Interior.ColorIndex = 15#
Summe1 = Application.WorksheetFunction.Sum(Bereich1)
Summe1.Interior.ColorIndex = 15#
Set Haker1 = Cells(iZeile, 33)
If Cells(iZeile, 23).Value  100 Then
Hakerl = "û"
With Hakerl.Font
.Name = "Wingdings"
.Bold = True
.ColorIndex = 3
End With
Else
Hakerl = "ü"
With Hakerl.Font
.Name = "Wingdings"
.Bold = True
.ColorIndex = 43
End With
End If
For iSpalte1 = 14 To 21
If iZeile = 17 Then
Cells(iZeile, 11) = 1
Cells(17, iSpalte1) = Cells(7, iSpalte1) + Cells(255, iSpalte1)
End If
If iZeile = 18 Then
Cells(iZeile, 11) = 1
Cells(18, iSpalte1) = Cells(19, iSpalte1) + Cells(53, iSpalte1) + Cells(101,  _
iSpalte1) + Cells(153, iSpalte1) + Cells(167, iSpalte1)
End If
If iZeile = 19 Then
Cells(iZeile, 11) = 1
Cells(19, iSpalte1) = Cells(20, iSpalte1) + Cells(27, iSpalte1)
End If
If iZeile = 20 Then
Cells(iZeile, 11) = 1
Cells(20, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(21, iSpalte1),  _
Cells(26, iSpalte1)))
End If
If iZeile = 27 Then
Cells(iZeile, 11) = 1
Cells(27, iSpalte1) = Cells(28, iSpalte1) + Cells(30, iSpalte1)
End If
If iZeile = 28 Then
Cells(iZeile, 11) = 1
Cells(28, iSpalte1) = Cells(29, iSpalte1)
End If
If iZeile = 30 Then
Cells(iZeile, 11) = 1
Cells(30, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(31, iSpalte1),  _
Cells(48, iSpalte1)))
End If
If iZeile = 48 Then
Cells(iZeile, 11) = 1
Cells(48, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(49, iSpalte1),  _
Cells(52, iSpalte1)))
End If
If iZeile = 53 Then
Cells(iZeile, 11) = 1
Cells(53, iSpalte1) = Cells(54, iSpalte1) + Cells(62, iSpalte1) + Cells(65,  _
iSpalte1) + Cells(73, iSpalte1) + Cells(75, iSpalte1) + Cells(83, iSpalte1) + Cells(87, iSpalte1) + Cells(89, iSpalte1) + Cells(91, iSpalte1)
End If
If iZeile = 54 Then
Cells(iZeile, 11) = 1
Cells(54, iSpalte1) = Cells(55, iSpalte1) + Cells(59, iSpalte1) + Cells(60,  _
iSpalte1) + Cells(61, iSpalte1)
End If
If iZeile = 55 Then
Cells(iZeile, 11) = 1
Cells(55, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(56, iSpalte1),  _
Cells(58, iSpalte1)))
End If
If iZeile = 62 Then
Cells(iZeile, 11) = 1
Cells(62, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(63, iSpalte1),  _
Cells(64, iSpalte1)))
End If
If iZeile = 65 Then
Cells(iZeile, 11) = 1
Cells(65, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(66, iSpalte1),  _
Cells(72, iSpalte1)))
End If
If iZeile = 73 Then
Cells(iZeile, 11) = 1
Cells(73, iSpalte1) = Cells(74, iSpalte1)
End If
If iZeile = 75 Then
Cells(iZeile, 11) = 1
Cells(75, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(76, iSpalte1),  _
Cells(82, iSpalte1)))
End If
If iZeile = 83 Then
Cells(iZeile, 11) = 1
Cells(83, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(84, iSpalte1),  _
Cells(86, iSpalte1)))
End If
If iZeile = 87 Then
Cells(iZeile, 11) = 1
Cells(87, iSpalte1) = Cells(88, iSpalte1)
End If
If iZeile = 89 Then
Cells(iZeile, 11) = 1
Cells(89, iSpalte1) = Cells(90, iSpalte1)
End If
If iZeile = 91 Then
Cells(iZeile, 11) = 1
Cells(91, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(92, iSpalte1),  _
Cells(96, iSpalte1))) + Cells(99, iSpalte1)
End If
If iZeile = 96 Then
Cells(iZeile, 11) = 1
Cells(96, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(97, iSpalte1),  _
Cells(98, iSpalte1)))
End If
If iZeile = 99 Then
Cells(iZeile, 11) = 1
Cells(99, iSpalte1) = Cells(100, iSpalte1)
End If
If iZeile = 101 Then
Cells(iZeile, 11) = 1
Cells(101, iSpalte1) = Cells(102, iSpalte1) + Cells(111, iSpalte1) + Cells(113,  _
iSpalte1)
End If
If iZeile = 102 Then
Cells(iZeile, 11) = 1
Cells(102, iSpalte1) = Cells(103, iSpalte1) + Cells(108, iSpalte1)
End If
If iZeile = 103 Then
Cells(iZeile, 11) = 1
Cells(103, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(104, iSpalte1), _
Cells(107, iSpalte1)))
End If
If iZeile = 108 Then
Cells(iZeile, 11) = 1
Cells(108, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(109, iSpalte1), _
Cells(110, iSpalte1)))
End If
If iZeile = 111 Then
Cells(iZeile, 11) = 1
Cells(111, iSpalte1) = Cells(112, iSpalte1)
End If
If iZeile = 113 Then
Cells(iZeile, 11) = 1
Cells(113, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(114, iSpalte1), _
Cells(144, iSpalte1))) + Cells(148, iSpalte1)
End If
If iZeile = 144 Then
Cells(iZeile, 11) = 1
Cells(144, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(145, iSpalte1), _
Cells(147, iSpalte1)))
End If
If iZeile = 148 Then
Cells(iZeile, 11) = 1
Cells(148, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(149, iSpalte1), _
Cells(152, iSpalte1)))
End If
If iZeile = 153 Then
Cells(iZeile, 11) = 1
Cells(153, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(154, iSpalte1), _
Cells(156, iSpalte1))) + Cells(160, iSpalte1) + Cells(164, iSpalte1) + Cells(165, iSpalte1) + Cells(166, iSpalte1)
End If
If iZeile = 156 Then
Cells(iZeile, 11) = 1
Cells(156, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(157, iSpalte1), _
Cells(159, iSpalte1)))
End If
If iZeile = 160 Then
Cells(iZeile, 11) = 1
Cells(160, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(161, iSpalte1), _
Cells(163, iSpalte1)))
End If
If iZeile = 167 Then
Cells(iZeile, 11) = 1
Cells(167, iSpalte1) = Cells(168, iSpalte1) + Cells(177, iSpalte1) + Cells(179,  _
iSpalte1) + Cells(184, iSpalte1) + Cells(191, iSpalte1) + Cells(205, iSpalte1) + Cells(213, iSpalte1) + Cells(228, iSpalte1) + Cells(251, iSpalte1)
End If
If iZeile = 168 Then
Cells(iZeile, 11) = 1
Cells(168, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(169, iSpalte1), _
Cells(176, iSpalte1)))
End If
If iZeile = 177 Then
Cells(iZeile, 11) = 1
Cells(177, iSpalte1) = Cells(178, iSpalte1)
End If
If iZeile = 179 Then
Cells(iZeile, 11) = 1
Cells(179, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(180, iSpalte1), _
Cells(183, iSpalte1)))
End If
If iZeile = 184 Then
Cells(iZeile, 11) = 1
Cells(184, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(185, iSpalte1), _
Cells(190, iSpalte1)))
End If
If iZeile = 191 Then
Cells(iZeile, 11) = 1
Cells(191, iSpalte1) = Cells(192, iSpalte1) + Cells(196, iSpalte1) + Cells(199,  _
iSpalte1) + Cells(202, iSpalte1)
End If
If iZeile = 192 Then
Cells(iZeile, 11) = 1
Cells(192, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(193, iSpalte1), _
Cells(195, iSpalte1)))
End If
If iZeile = 196 Then
Cells(iZeile, 11) = 1
Cells(196, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(197, iSpalte1), _
Cells(198, iSpalte1)))
End If
If iZeile = 199 Then
Cells(iZeile, 11) = 1
Cells(199, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(200, iSpalte1), _
Cells(201, iSpalte1)))
End If
If iZeile = 202 Then
Cells(iZeile, 11) = 1
Cells(202, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(203, iSpalte1), _
Cells(204, iSpalte1)))
End If
If iZeile = 205 Then
Cells(iZeile, 11) = 1
Cells(205, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(206, iSpalte1), _
Cells(212, iSpalte1)))
End If
If iZeile = 213 Then
Cells(iZeile, 11) = 1
Cells(213, iSpalte1) = Cells(214, iSpalte1) + Cells(225, iSpalte1)
End If
If iZeile = 214 Then
Cells(iZeile, 11) = 1
Cells(214, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(215, iSpalte1), _
Cells(222, iSpalte1)))
End If
If iZeile = 222 Then
Cells(iZeile, 11) = 1
Cells(222, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(223, iSpalte1), _
Cells(224, iSpalte1)))
End If
If iZeile = 225 Then
Cells(iZeile, 11) = 1
Cells(225, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(226, iSpalte1), _
Cells(227, iSpalte1)))
End If
If iZeile = 228 Then
Cells(iZeile, 11) = 1
Cells(228, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(229, iSpalte1), _
Cells(241, iSpalte1))) + Cells(244, iSpalte1) + Cells(245, iSpalte1) + Cells(246, iSpalte1) + Cells(249, iSpalte1)
End If
If iZeile = 241 Then
Cells(iZeile, 11) = 1
Cells(241, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(242, iSpalte1), _
Cells(243, iSpalte1)))
End If
If iZeile = 246 Then
Cells(iZeile, 11) = 1
Cells(246, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(247, iSpalte1), _
Cells(248, iSpalte1)))
End If
If iZeile = 249 Then
Cells(iZeile, 11) = 1
Cells(249, iSpalte1) = Cells(250, iSpalte1)
End If
If iZeile = 251 Then
Cells(iZeile, 11) = 1
Cells(251, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(252, iSpalte1), _
Cells(254, iSpalte1)))
End If
If iZeile = 255 Then
Cells(iZeile, 11) = 1
Cells(255, iSpalte1) = Cells(256, iSpalte1) + Cells(263, iSpalte1)
End If
If iZeile = 256 Then
Cells(iZeile, 11) = 1
Cells(256, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(257, iSpalte1), _
Cells(259, iSpalte1))) + Cells(262, iSpalte1)
End If
If iZeile = 259 Then
Cells(iZeile, 11) = 1
Cells(259, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(260, iSpalte1), _
Cells(261, iSpalte1)))
End If
If iZeile = 263 Then
Cells(iZeile, 11) = 1
Cells(263, iSpalte1) = Application.WorksheetFunction.Sum(Range(Cells(264, iSpalte1), _
Cells(266, iSpalte1)))
End If
Next iSpalte1
Select Case iZeile
Case 17, 18, 19, 20, 27, 28, 30, 48, 53, 54, 55, 62, 65, 73, 83, 87, 89, 91, 96
Range(Cells(iZeile, 13), Cells(iZeile, 21)).Interior.ColorIndex = 15#
Case 99, 101, 102, 103, 108, 111, 113, 144, 148, 153, 156, 160, 167, 168
Range(Cells(iZeile, 13), Cells(iZeile, 21)).Interior.ColorIndex = 15#
Case 177, 179, 184, 191, 192, 196, 199, 202, 205, 213, 214, 222, 225, 228
Range(Cells(iZeile, 13), Cells(iZeile, 21)).Interior.ColorIndex = 15#
Case 241, 246, 249, 251, 255, 256, 259, 263
Range(Cells(iZeile, 13), Cells(iZeile, 21)).Interior.ColorIndex = 15#
End Select
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
ErrorHandler:
MsgBox "Fehler bla bla"
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige