Eingabezellen umrahmen
28.06.2007 09:10:11
Born
Hallo,
ich möchte in folgender Tabelle die Eingabezellen per Makro zwecks Deutlichkeit einrahmen
lassen. Dazu existiert schon ein Makro, welches aber nur in leeren Zellen funktioniert.
Könnte mir jemand bitte einen Tipp geben, was daran zu ändern ist, damit es auch in der
beigefügten Tabe klappt?
Hier die Tabelle:
Die Datei https://www.herber.de/bbs/user/43647.xls wurde aus Datenschutzgründen gelöscht
Die Tabelle funktioniert so:1. In spalte J wird ein Wert eingetragen
2. dieser Wert wird nach Spalte B übertragen
3. In spalte E und F wird ausgegeben, in welcher Häufigkeit der Wert erschienen ist.
Zurück zu meinem ursprünglichen Anliegen:
Das Makro soll, sobald in Spalte A ein neuer Wert erscheint (übertragen aus J), einen Strich drunter ziehen und die nächstfolgende Zelle in spalte G und H (rot) einrahmen. In der Beispieltabelle wäre der Strich
im Moment unter Zeile 59 und die rote umrahmten Zellen wären G60 und H60.
Ganz klasse wäre, wenn das Makro noch eine kleine Zusatzfunktion erfüllen würde:
Wenn in Spalte J statt Äpfel oder Birnen "Pflaumen" eingetragen werden, soll der
Zellinhalt von Spalte G und H/letzte Zeile in die nächste Zeile übernommen werden.
(das würde mit Excel einfach funktionieren durch die Formel in G60 (bzw. H6)
=wenn(oder (j60="Äpfel"; j60="Birnen");G59;"") - aber ich kann diese Formel in den
spalten G und H nicht brauchen.
Dieses Makro ist bereits von Sepp zur Verfügung gestellt worden:
(funktioniert aber - wie gesagt - leider nur in leeren Zellen)
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private lngRow As Long
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrExit
Application.EnableEvents = False
With Target
If .Count = 1 Then
If .Column = 1 Then
If .Row = Cells(Rows.Count, 1).End(xlUp).Row Then
lngRow = .Row + 1
Range("A:L").Borders.LineStyle = xlNone
Range("A" & .Row & ":L" & .Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
Cells(.Row + 1, 4).BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color: _
_
_
_
=RGB(255, 0, 0)
Cells(.Row + 1, 7).BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color: _
_
_
_
=RGB(255, 0, 0)
Cells(.Row + 1, 10).BorderAround LineStyle:=xlContinuous, Weight:=xlThick, _
Color:=RGB(255, 0, 0)
Cells(.Row + 1, 4).Activate
End If
ElseIf .Column = 4 Then
.Offset(0, 3).Activate
ElseIf .Column = 7 Then
.Offset(0, 3).Activate
ElseIf .Column = 10 Then
.Offset(0, -9).Activate
End If
End If
End With
ErrExit:
Application.EnableEvents = True
End Sub
Herzlichen Dank,
Born