Doppelklick und bedingte Formatierung
27.09.2004 17:23:05
Stephi
habe folgendes Problem und hoffe, dass mir jemand helfen kann:
Ich möchte mit einem Doppelklick das Tabellenblatt wechseln und möchte, dass der Curser jeweils an die Stelle (SOLL oder IST oder VAR der entsprechenden Kennzahl) im zugehörigen Produkttabellenblatt springt, die verantwortlich für das Resultat ist. Verantwortlich heisst genauer gesagt, dass ich die Felder bedingt Formatiert habe und dass es toll wäre, dass der Curser beim Doppelklick auf ein rotes Feld den kleinsten Wert im entsprechenden Tabellenblatt sucht und bei Doppelklick auf ein grünes Feld den grössten Wert. Bei einem gelb unterlegten Feld soll das Feld, dass dem Wert am nahesten kommt ausgewählt werden
Zum besseren Verständnis habe ich eine Mustertabelle angehängt. Der Code funktioniert leider nicht richtig und das Thema mit der bedingten Formatierung beim Doppelklick konnte ich nicht realisieren.
Vielen Dank schon mal für Hilfe.
Stephi
https://www.herber.de/bbs/user/11372.xls
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim rng As Range
Dim byRow As Byte, i As Byte, j As Byte
Dim DblStart As Double
Set rng = Range("B3:D9")
If Intersect(Target, rng) Is Nothing Then Exit Sub
byRow = Target.Row
With Sheets("ProduktA")
DblStart = .Cells(byRow, 2).Value
j = 2
For i = 2 To 10 Step 3
If .Cells(byRow, i).Value < DblStart Then
DblStart = .Cells(byRow, i).Value
j = i
End If
Next
.Activate
.Cells(byRow, j).Select
.Rows(byRow).Hidden = False
End With
Dim rng As Range
Dim byRow As Byte, i As Byte, j As Byte
Dim DblStart As Double
Set rng = Range("E3:G9")
If Intersect(Target, rng) Is Nothing Then Exit Sub
byRow = Target.Row
With Sheets("ProduktB")
DblStart = .Cells(byRow, 2).Value
j = 2
For i = 2 To 8 Step 3
If .Cells(byRow, i).Value < DblStart Then
DblStart = .Cells(byRow, i).Value
j = i
End If
Next
.Activate
.Cells(byRow, j).Select
.Rows(byRow).Hidden = False
End With
Dim rng As Range
Dim byRow As Byte, i As Byte, j As Byte
Dim DblStart As Double
Set rng = Range("H3:J9")
If Intersect(Target, rng) Is Nothing Then Exit Sub
byRow = Target.Row
Cancel = True
With Sheets("ProduktC")
DblStart = .Cells(byRow, 2).Value
j = 2
For i = 2 To 8 Step 3
If .Cells(byRow, i).Value < DblStart Then
DblStart = .Cells(byRow, i).Value
j = i
End If
Next
.Activate
.Cells(byRow, j).Select
.Rows(byRow).Hidden = False
End With
End Sub
Anzeige