noch ein Vorschlag
23.04.2013 17:06:03
Erich
Hi Philipp,
hier noch ein Vorschlag - zunächst der Code (ist eine Ereignisprozedur,
gehört also in den Code der Tabelle):
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBed As Range, arBed, rngW As Range, arW
Dim rr As Long, cc As Long
Dim lngR1 As Long, lngC1 As Long
Dim rngHR As Range, rngHC As Range
Set rngBed = Range("C4:E5") ' Bereich mit Bedíngungen
lngR1 = 11 ' erste Datenszeile
lngC1 = 6 ' erste Datenspalte
If Intersect(Target, rngBed) Is Nothing Then Exit Sub
arBed = Cells(4, 3).Resize(2, 3)
Set rngW = Cells(lngR1, lngC1).CurrentRegion
arW = rngW
lngR1 = lngR1 - 1
lngC1 = lngC1 - 1
For rr = 2 To UBound(arW)
If Not IsEmpty(arBed(1, 1)) And arBed(1, 1) > arW(rr, 1) Then _
Call RngUnion(rngHR, Cells(lngR1 + rr, 1))
If Not IsEmpty(arBed(2, 1)) And arBed(2, 1) arW(rr, 2) Then _
Call RngUnion(rngHR, Cells(lngR1 + rr, 1))
If Not IsEmpty(arBed(2, 2)) And arBed(2, 2) arW(1, cc) Then _
Call RngUnion(rngHC, Cells(1, lngC1 + cc))
If Not IsEmpty(arBed(2, 3)) And arBed(2, 3)
und hier die BeiSpielMappe:
https://www.herber.de/bbs/user/85024.xlsm
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich