Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
640to644
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
640to644
640to644
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Differenz ausrechnen

Differenz ausrechnen
26.07.2005 08:02:54
Nicole
Hallo zusammen,
in meinem Excelsheet habe ich in den Spalten B und C Werte, die sich laufend ändern. In Spalte D wird die Differenz von C-B erfasst. Der Wert in Spalte D soll sich aber nur dann ändern, wenn die Differenz größer wird. Wenn die Differnz kleiner wird, soll der Wert in D bleiben, wie er ist.
Dafür benutze ich diesen Code :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If [C1] - [B1] > [D1] Then [D1] = [C1] - [B1]
If [C2] - [B2] > [D2] Then [D2] = [C2] - [B2]
If [C3] - [B3] > [D3] Then [D3] = [C3] - [B3]
If [C4] - [B4] > [D4] Then [D4] = [C4] - [B4]
If [C5] - [B5] > [D5] Then [D5] = [C5] - [B5]
If [C6] - [B6] > [D6] Then [D6] = [C6] - [B6]
If [C7] - [B7] > [D7] Then [D7] = [C7] - [B7]
If [C8] - [B8] > [D8] Then [D8] = [C8] - [B8]
End Sub

Bisher hatte mein ExcelSheet 8 Zeilen und es hat wunderbar funktioniert. Nun habe ich seit einiger Zeit 300 Zeilen und das schafft mein Rechner nicht, er hängt sich dauernd auf. Was kann ich tun?
Gruß
Nicole

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Differenz ausrechnen
26.07.2005 08:11:09
Marciavelli
Hallo Nicole,
wuerde es mal mit einer If-Schleife versuchen und das Makro Zeile fuer Zeile durchgehen lassen. Als Abbruchbedingung der Schleife, waere zum Beispeil das Finden einer leeren Zelle oder eines "Stop" in einer Zelle sinnvoll. Ausserdem ist der Programmcode kuerzer ;)
Gruss
Machiavelli
AW: Differenz ausrechnen
26.07.2005 08:39:28
Heinz
Hallo Nicole,
am besten verwendest das Klassenmodul der Tabelle.
Also rechte Maustaste auf das Register der Tabelle und Code anzeigen wählen, dann folgenden Code eingeben:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 And Target.Column <> 3 Then Exit Sub
If Cells(Target.Row, 3).Value - Cells(Target.Row, 2).Value > Cells(Target.Row, 4).Value Then _
Cells(Target.Row, 4).Value = Cells(Target.Row, 3).Value - Cells(Target.Row, 2).Value
End Sub

Dabei wird immer, wenn in der Spalte B oder C etwas eingegeben wird, überprüft, ob der Wert in der Spalte D größer ist als die Differenz zwischen B und C. Wenn nein wird der Wert in D durch die aktuelle Differenz ersetzt.
Gruß
Heinz
Anzeige
klappt perfekt. Vielen Dank
26.07.2005 09:13:53
Nicole
klappt perfekt. Vielen Dank
AW: Differenz ausrechnen
26.07.2005 09:19:54
UweD
Hallo Nicole
du hast den Bereich, bei dem das change_ereignis ausgeführt wird nicht begrenzt.
Wenn in Spalte B oder C ein Change durchgeführt wurde, wurde je nach If... eine Änderung in D hervorgerufen. Das wiederum hat erneut das change_ereignis ausgelöst...
bei 8 Zeilen hat das sich irgendwann wieder beruhigt... aber bei 300 Zeilen kann das dauern.
Du mußt auch nicht immer alle Zeilen überprüfen, sondern nur die Reihe, die sich gerade geändert hat. (Target.Row). und dann auch nur Spalte B und C überwachen. Dadurch wird z.B wenn in D der neue Wert eingetragen wird das Makro nicht neu ausgelöst.
So gehts:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R%
If Not Intersect(Target, Range("B:C")) Is Nothing Then 'überwacht auch nur Spalte B und C
R = Target.Row
If Cells(R, 3) - Cells(R, 2) > Cells(R, 4) Then
Cells(R, 4) = Cells(R, 3) - Cells(R, 2)
End If
End If
End Sub

Gruß UweD
(Rückmeldung wäre schön)
Anzeige
hat geklappt. Danke!!
26.07.2005 09:39:28
Nicole
AW: Differenz ausrechnen
26.07.2005 11:51:01
Nicole
Hallo zusammen,
eine Frage hätte ich noch:
kann man die Formel so umwandeln, dass sie die Differenz in D absolut betrachtet wird, also unanhängig vom Vorzeichen?
Beispiel:
Wert in Spalte D = 2
Differenz C-B = -3
Da -3 kleiner ist als 2 würde der Wert in D konstant bleiben. Ich hätte aber gerne, dass D hier auf 3 ansteigt, da die abolute Differenz größer geworden ist.
Schon mal danke für Eure Hilfe
Gruß
Nicole
AW: Differenz ausrechnen
26.07.2005 13:13:46
UweD
Hallo nochmal
nimm diese Formel:

If Abs(Cells(R, 3) - Cells(R, 2)) > Cells(R, 4) Then
Cells(R, 4) = Abs(Cells(R, 3) - Cells(R, 2))
End If

Gruß UweD
(Rückmeldung wäre schön)
Anzeige
klappt. Vielen, vielen Dank
26.07.2005 13:18:51
Nicole
AW: Differenz ausrechnen, Restproblem
27.07.2005 08:20:38
Nicole
Hallo zusammen,
erst nochmal vielen Dank für eure Hilfe, ohne euch wäre ich echt aufgeschmissen. Die Formeln funktionieren super, es bleibt mir aber noch ein Restproblem:
Wenn ich in B oder C den Wert direkt ändere (Zelle anklicken, Wert eintragen, Return drücken) funktioniert der Code perfekt.
Wenn ich den Wert indirekt ändere (Formeln in C : (E+F)/2. Wenn ich in E den Wert ändere, ändert er sich automatisch auch in C.) reagiert der Code nicht mehr. Gibt es dafür auch eine Lösung?
Gruß
Nicole
AW: Differenz ausrechnen, Restproblem
27.07.2005 10:22:48
Heinz
Hallo Nicole,
einfach so:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R%
If Not Intersect(Target, Range("B:C, E:F")) Is Nothing Then 'überwacht Spalten B, C, E und F
R = Target.Row
If Abs(Cells(R, 3) - Cells(R, 2) > Cells(R, 4)) Then
Cells(R, 4) = Cells(R, 3) - Cells(R, 2)
End If
End If
End Sub

Gruß
Heinz
Anzeige
klappt!!!! 1000 Dank
27.07.2005 10:30:09
Nicole
AW: Differenz ausrechnen, allerletzte Frage
28.07.2005 09:29:07
Nicole
Hallo,
eine allerletzte Frage habe ich noch:
wenn in der Spalte E oder F eine Null steht, soll nicht gerechnet werden, da eine Null ein Fehler ist und mein Ergebnis verfälscht. Gibt es da auch noch einen Befehl für?
Lieben Gruß
Nicole
AW: Differenz ausrechnen, allerletzte Frage
28.07.2005 10:51:55
UweD
Hallo nicole
eine Zeile ergänzt.. Gilt aber auch, wenn die Zellen kompl. leer sind...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R%
If Not Intersect(Target, Range("B:C, E:F")) Is Nothing Then 'überwacht Spalten B, C, E und F
R = Target.Row
If Cells(R, 5).Value = 0 Or Cells(R, 6)).Value  = 0 Then Exit Sub '!!!!
If Abs(Cells(R, 3) - Cells(R, 2) > Cells(R, 4)) Then
Cells(R, 4) = Cells(R, 3) - Cells(R, 2)
End If
End If
End Sub

Gruß UweD
(Rückmeldung wäre schön)
Anzeige
hat wunderbar funktioniert!!!
28.07.2005 11:55:40
Nicole

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige