Formatierung

Sub Rahmen() ' unten With Range("a5:F250") .Borders(xlEdgeBottom).Weight = xlThick End With ' zwischen den zeilen With Range("a5:F250").Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThick End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Formatierung

10.11.2005 09:42:35

Luschi

AW: Formatierung

10.11.2005 10:11:29

Jürg

AW: Formatierung

10.11.2005 14:06:27

Luschi

AW: Formatierung

10.11.2005 14:45:38

Jürg

Sub Rahmen() Dim rg1 As Range, rg2 As Range, xStrich As Integer, _ v1, v2 'Berechnung und Bildschirmaktualisierung ausschalten _ damit verhindert man das Bildschirmflackern _ wird zum Schluß wieder aktiviert! Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Set rg1 = ThisWorkbook.Worksheets("Tabelle1").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 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 rg2.Borders(xlEdgeBottom).Weight = xStrich End If Else rg2.Borders(xlEdgeBottom).Weight = xlHairline End If Next rg2 Set rg1 = Nothing Set rg1 = Nothing Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

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

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread