Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
976to980
976to980
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Überprüfung von Zellen mit Worksheet change

Überprüfung von Zellen mit Worksheet change
14.05.2008 07:47:00
Zellen
Mit folgendem Code überprüfe ich Zellen in der Spalte C und Spalte F nach Veränderungen in der Tabelle. Normalerweise befindet sich dort eine Formel die einen Wert aus G und J für Spalte C, oder I und J für Spalte F errechnet. Es kann aber passieren, das in eine Zelle der Spalten C und F der Wert direkt eingetippt wird. In diesem Fall errechnen die ersten beiden For each .. next Schleifen den Prozentwert, der dann in dazugeörige Zeile der Spalte G für C oder I für F eingetragen wird. Dies funktioniert auch problemlos, nur bei größeren Tabellen dauert die Berechnung eben.
Die dritte Schleife vergleicht die Werte der Spalten C und F zeilenweise mit einem jemweils zugehörigen Grenzwert. Bei Unterschreitung dessen werden die entsprechenden Zellen in den Spalten g und i rot markiert.
Nun überlege ich wie ich diese aufwendige Prozedur einfacher und damit schneller gestalten kann. Kann mir jemend ein paar Tips geben?
Gruß aus Halle
Bernd Cramer

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ber_0 As Range, ber_1 As Range, ber_2 As Range
Dim zeile, start, sprung As Integer
Dim test, adr, forml As String
Dim zelle1, zelle2 As Double
On Error Resume Next
If kopie = 0 Then
Application.DisplayAlerts = False
introw2 = Trim(Str(Range("a65536").End(xlUp).Row))
adr = "C5:C" + introw2
Set ber_0 = Range("C5:C" & introw2)
If Not Intersect(Target, ber_0) Is Nothing Then
For Each ber_1 In ber_0
Set ber_2 = ber_1.Offset(0, 7) 'gleiche Zeile aber Spalte J
If IsNumeric(ber_1.Value) And (""  ber_1.Value) Then
If Not ber_1.HasFormula Then
If ""  ber_2.Value Then
zelle1 = ber_1.Value
zelle2 = ber_2.Value
zelle1 = 1 - (zelle1 / zelle2)
ber_1.Offset(0, 4).Value = zelle1 'gleiche Zeile aber Spalte G
End If
End If
End If
Next
End If
Set ber_0 = Nothing
Set ber_1 = Nothing
Set ber_2 = Nothing
adr = "F5:F" + introw2
Set ber_0 = Range("F5:F" & introw2)
If Not Intersect(Target, ber_0) Is Nothing Then
For Each ber_1 In ber_0
Set ber_2 = ber_1.Offset(0, 4) 'gleiche Zeile aber Spalte J
If IsNumeric(ber_1.Value) And (""  ber_1.Value) Then
If Not ber_1.HasFormula Then
If ""  ber_2.Value Then
zelle1 = ber_1.Value
zelle2 = ber_2.Value
zelle1 = 1 - (zelle1 / zelle2)
ber_1.Offset(0, 3).Value = zelle1 'gleiche Zeile aber Spalte I
End If
End If
End If
Next
End If
Set ber_0 = Nothing
Set ber_1 = Nothing
Set ber_2 = Nothing
Application.DisplayAlerts = True
Cells(zeile, 3).Interior.ColorIndex = xlColorIndexNone
Cells(zeile, 6).Interior.ColorIndex = xlColorIndexNone
For zeile = 5 To introw2
If Cells(zeile, 3).Value  "" Then
If Cells(zeile, 3).Value > 0 Then
If Cells(zeile, 3).Value  "" Then
If Cells(zeile, 6).Value > 0 Then
If Cells(zeile, 6).Value 


1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Überprüfung von Zellen mit Worksheet change
14.05.2008 16:11:17
Zellen
Hi Bernd,
benutze Option Explicit.
Zeilen immer als Long deklarieren.
Jede Variable braucht ein eigenes As, so wie du es beim ersten Dim getan hast.
Setze Hochkamma vor On Error resume next dann springt der Debugger sicher zu
Cells(zeile,3)...
da es keine Zelle C0 gibt
Tausche
introw2 = Trim(Str(Range("a65536").End(xlUp).Row))
gegen
lngRow2 = Range("a" & Rows.count).End(xlUp).Row
Tausche

For zeile = 5 To introw2
If Cells(zeile, 3).Value  "" Then
If Cells(zeile, 3).Value > 0 Then
If Cells(zeile, 3).Value 


gegen


Cells(zeile, 7).Interior.ColorIndex = xlNone
For zeile = 5 To introw2
If Cells(zeile, 3).Value > 0 Then
If Cells(zeile, 3).Value 


Tausche


For Each ber_1 In ber_0
Set ber_2 = ber_1.Offset(0, 4) 'gleiche Zeile aber Spalte J
If IsNumeric(ber_1.Value) And (""  ber_1.Value) Then
If Not ber_1.HasFormula Then
If ""  ber_2.Value Then
zelle1 = ber_1.Value
zelle2 = ber_2.Value
zelle1 = 1 - (zelle1 / zelle2)
ber_1.Offset(0, 3).Value = zelle1 'gleiche Zeile aber Spalte I
End If
End If
End If
Next


gegen


For Each ber_1 In ber_0
With ber_1
If IsNumeric(.Value) Then
If Not .HasFormula Then
If ""  .Offset(0, 4).Value Then .Offset(0, 3).Value = 1 - (.Value / . _
Offset(0, 4).Value)                         'gleiche Zeile aber Spalte I
End If
End If
End With
Next


Und mache alle Änderungen Stück für Stück und immer wieder zwischendurch testen, nicht alles auf einmal ändern!
Gruß
Reinhard

Anzeige

250 Forumthreads zu ähnlichen Themen


Hallo zusammen,
Markus hat in https://www.herber.de/forum/archiv/1012to1016/t1013729.htm ein IMHO interessantes Problem gepostet.
Da der Thread jetzt bald ins Archiv wandert, wir aber noch keine Erklärung gefunden haben,
stelle ich die Frage hier nochmal ein.
In der Beispielmapp...
Anzeige


Hallo Könner,
mal wieder an einem Punkt angekommen, wo ich echt nicht weiß, ob die PCs was Magisches können.
Das Makro unten ist prima gelaufen. Und dann mal wieder nicht. Jetzt gerade mal wieder nicht, daher mein Hilferuf. Als mir das das erste Mal passiert ist, habe ich den ganze...

Guten Tag allerseits,
ich hoffe es ist jemand so nett, sich meiner anzunehmen und unterstützt mich bei der Lösung folgenden Problems:
Ich möchte ein Excel-Diagramm (2003) dynamisch über veränderbare Werte aus bestimmten Zellen skalieren. Es handelt sich um ein Diagramm mit jeweils primä...
Anzeige

Guten Abend!
ich versuche mich gerade ein bißchen in VBA insbesondere das worksheet change event zu vertiefen und würde mich über einen Rat freuen.
In A1:A5 habe ich sich verändernde Zahlen von 1 bis 3. Wenn sich in der Spalte A ein Wert verändert, sollen in der entsprechenden Zeile - u...

Hallo, hat evtl jemand eine Lösung für mich diesen Code umzubauen. Momentan funktioniert der so dass alle Mappen in der Datei mit dem Format ausgelöst werden. Es müsste allerdings ausgesuchte Tabellen sein.
Also z.B. Tabelle 1 und 3 und 8 wird mit dem Code formatiert... alle anderen Tabelle...

Hallo Kollegen,
ich habe ein Problem bei der .CreateEventProc("Change", "Worksheet")
Mein Code sieht wie folgt aus
Sub Makro_in_Worksheet_zufügen() Dim x As Variant, x1 As Long, x2 As Long, Anzahl_der_Zeilen As Long, Tabellennummer As _ String DIM Tabellenname As String Applicati...
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige