Monitoring eines Zellbereichs mit .OnAction
08.10.2014 08:33:25
Tobi
ich möchte einen variablen Zellbereich ( Größe je nach Benutzereingabe ) überwachen lassen.
Und zwar gibt es eine ComboBox in der nur zwei Werte zur Auswahl stehen und in die verlinkte Zelle wird je nach Auswahl eine "1" oder eine "2" geschrieben.
Zusätzlich sollen alle Zellen die z.b. eine 1 haben, den gleichen Wert annehmen, den ich eingebe.
Hier mein Code, der zwar erstmal funktioniert, aber eben sehr umständlich arbeitet, da man vor der Auswahl des Zustandes immer schon den Wert eingeben muss, der dann für alle Zellen mit dem gleichen Zustand übernommen werden soll:
Sub Änderung_switch2()
With ActiveSheet.Shapes(Application.Caller)
Row = Range(.ControlFormat.LinkedCell).Row
Column = Range(.ControlFormat.LinkedCell).Column
Select Case Sengctr
Case 1
rowup = 0
rowdown = 0
Case 2
rowup = 1
rowdown = 1
Case 3
rowup = 2
rowdown = 2
Case 4
rowup = 3
rowdown = 3
Case 5
rowup = 4
rowdown = 4
Case 6
rowup = 5
rowdown = 5
End Select
If Range(.ControlFormat.LinkedCell).value = 2 Then
Range("K" & Row).Formula = "=get_SFOCpartload(F" & Row & ")"
Range("F" & Row).Interior.Color = RGB(255, 185, 15)
Range("K" & Row).Interior.Color = RGB(255, 185, 15)
For i = 1 To rowdown
If Range("E" & Row - i).value = "" Then Exit Sub
If Range("E" & Row - i).value = 2 Then
zeile = Range("E" & Row - i).Row
Range("F" & zeile).Formula = "=F" & Row & ""
End If
Next
For i = 1 To rowup
If Range("E" & Row + i).Borders(xlEdgeBottom).Weight = xlThick Then Exit Sub
If Range("E" & Row + i) = 2 Then
zeile = Range("E" & Row + i).Row
Range("F" & zeile).Formula = "=F" & Row & ""
End If
Next
End If
If Range(.ControlFormat.LinkedCell).value = 1 Then
Range("K" & Row).Formula = "=get_SFOCstandard(F" & Row & ")"
Range("F" & Row).Interior.Color = vbWhite
Range("K" & Row).Interior.Color = vbWhite
For i = 1 To rowdown
If Range("E" & Row - i).value = "" Then Exit Sub
If Range("E" & Row - i).value = 1 Then
zeile = Range("E" & Row - i).Row
Range("F" & zeile).Formula = "=F" & Row & ""
End If
Next
For i = 1 To rowup
If Range("E" & Row + i).Borders(xlEdgeBottom).Weight = xlThick Then Exit Sub
If Range("E" & Row + i).value = 1 Then
zeile = Range("E" & Row + i).Row
Range("F" & zeile).Formula = "=F" & Row & ""
End If
Next
End If
End With
End Sub
Dass das mit rowup, rowdown überflüssig ist, weiß ich ;)
Danke schon mal für eure Mühe
Anzeige