AW: Formatierung
10.11.2005 14:06:27
Luschi
Hallo Jürg,
hier die (kleine) Änderung:
Sub Rahmen()
Dim rg1 As Range, rg2 As Range, rg3 As Range, _
xStrich As Integer, _
v1, v2, n As Long, _
wb As Workbook, ws As Worksheet
'Berechnung und Bildschirmaktualisierung ausschalten _
damit verhindert man das Bildschirmflackern _
wird zum Schluß wieder aktiviert!
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Tabelle1")
Set rg1 = ws.Range("C5:C250")
For Each rg2 In rg1
v1 = rg2.Value 'z.B.: Zelle C5
v2 = rg2.Offset(1, 0) '1 Zeile tiefer, selbe Spalte: Zelle C6
'MsgBox v1 & " - " & v2
n = rg2.Row
Set rg3 = ws.Range("A" & n & ":Q" & n)
If "" <> v1 And "" <> v2 Then
'Leere Zellen auschließen
If VarType(v1) = VarType(v2) Then
'nur Zellen mit gleichem ZellTyp können verglichen werden
If v1 = v2 Then
xStrich = xlThick
Else
xStrich = xlHairline
End If
rg3.Borders(xlEdgeBottom).Weight = xStrich
End If
Else
'gepunkteteHaarlinie
'rg3.Borders(xlEdgeBottom).Weight = xlHairline
'kein Rahmen
rg3.Borders.LineStyle = xlNone
End If
Next rg2
'Objekt-Variablen wieder frei geben
Set rg1 = Nothing
Set rg1 = Nothing
Set rg3 = Nothing
Set ws = Nothing
Set wb = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Gruß von Luschi
aus klein-Paris