Überprüfung von Zellen mit Worksheet change
14.05.2008 07:47:00
Zellen
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