Code bitte mal überprüfen
16.06.2016 23:11:28
Patrick
Hallo,
da ich mich natürlich auch selbst bemühe, meine Aufgaben irgendwie zu lösen, habe ich mich mal was in VBA eingelesen.
Mein Problem ist, dass in einer bereits mal hochgeladenen Tabelle, trotz Code-Anpassung zwei Spalten mit gefüllten Zeilen nicht automatisch mit formatiert wurden, wie es bei allen anderen mit dem Code geklappt hat.
Also habe ich den Code nochmal angepasst, es funktioniert noch immer nicht.
Die Formatierung aus dem Code soll auch bei Zellen in Spalte N und O durchgeführt werden, geschieht aber nicht. Hier sind die Codes, vielleicht mag ja einer nachsehen, was falsch ist. Wäre sehr dankbar...
DieseArbeitsmappe:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Calculation = xlCalculationAutomatic
Dim bereich1 As Range
Dim bereich2 As Range
Dim GesamtBereich As Range
Dim zelle As Range
Set bereich1 = Tabelle8.Range("J2:K1500") 'Bereich mit Formeln, Bereich ggf. anpassen
Set bereich2 = Tabelle8.Range("M2:O1500")
Set GesamtBereich = Union(bereich1, bereich2)
With Tabelle8
For Each zelle In GesamtBereich
If zelle <> "" Then
.Range(.Cells(zelle.Row, 1), .Cells(zelle.Row, 13)).Borders.Weight = xlThin
.Range(.Cells(zelle.Row, 1), .Cells(zelle.Row, 13)).HorizontalAlignment = xlCenter
.Range(.Cells(zelle.Row, 1), .Cells(zelle.Row, 13)).VerticalAlignment = xlCenter
With .Range(.Cells(zelle.Row, 1), .Cells(zelle.Row, 13)).Font
.Name = "Arial"
.Size = 8
.Bold = True
End With
End If
Next
End With
End Sub
Tabelle8:Private Sub Worksheet_Change(ByVal Target As Range)
Dim bereich1 As Range
Dim bereich2 As Range
Dim GesamtBereich As Range
Dim zelle As Range
Set bereich1 = Tabelle8.Range("A2:I1500") 'Bereich mit händischen Eintragungen, ggf. anpassen
Set bereich2 = Tabelle8.Range("L2:L1500")
Set GesamtBereich = Union(bereich1, bereich2)
With Tabelle8
For Each zelle In GesamtBereich
If zelle <> "" Then
.Range(.Cells(zelle.Row, 1), .Cells(zelle.Row, 13)).Borders.Weight = xlThin
.Range(.Cells(zelle.Row, 1), .Cells(zelle.Row, 13)).HorizontalAlignment = xlCenter
.Range(.Cells(zelle.Row, 1), .Cells(zelle.Row, 13)).VerticalAlignment = xlCenter
With .Range(.Cells(zelle.Row, 1), .Cells(zelle.Row, 13)).Font
.Name = "Arial"
.Size = 8
.Bold = True
End With
End If
Next
End With
End Sub