ich habe ein Problem! Habe ein Makro erstellt, leider läuft es sehr langsam! Ich schreibe es jetzt hier rein, vielleicht habt Ihr ja irgendwelche Verbesserungsvorschläge:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
HIER FÜGT ER MIR IN MEINER TABELLE EINE SPALTE HINZU
(Wenn Eintrag in Zeile 31)
If Target.Row = 31 And Target.Column > 7 Then
If Target.Value <> "" Then
Columns(Target.Column + 1).Insert
HIER WERDEN BESTEHENDE FORMELN IN DIE NEU EINGEFÜGTE ZEILE EINGEFÜGT:
(Hier ist das Problem, da ich erst überprüfe, ob die Zellen umrahmt sind, wenn ja, dann fügt er erst die Formeln ein)
For l = 8 To 20
With Cells(40, l)
If .Borders(xlEdgeLeft).LineStyle = xlContinuous And
.Borders(xlEdgeTop).LineStyle = xlContinuous And _
.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
.Borders(xlEdgeRight).LineStyle = xlContinuous Then
.FormulaR1C1 = Cells(40, 5).FormulaR1C1
End If
End With
With Cells(41, l)
If .Borders(xlEdgeLeft).LineStyle = xlContinuous And _
.Borders(xlEdgeTop).LineStyle = xlContinuous And _
.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
.Borders(xlEdgeRight).LineStyle = xlContinuous Then
.FormulaR1C1 = Cells(41, 5).FormulaR1C1
End If
End With
With Cells(42, l)
If .Borders(xlEdgeLeft).LineStyle = xlContinuous And _
.Borders(xlEdgeTop).LineStyle = xlContinuous And _
.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
.Borders(xlEdgeRight).LineStyle = xlContinuous Then
.FormulaR1C1 = Cells(42, 5).FormulaR1C1
End If
End With
Next l
WENN ICH DEN WERT AUS ZEILE 31 NEHME, DANN LÖSCHT ER DIE SPALTE:
ElseIf Target.Column > 8 Then
Columns(Target.Column).Delete
Application.ScreenUpdating = True
End If
End If
HIER FÜGT ER DER NEU EINGEFÜGTEN ZELLE EINE UMRANDUNG ZU:
(Mein Problem hier war, dass wenn ich eine neue Spalte einfüge, nur die Hintergrundfarbe "grau" eingefügt wird, die Umrandung leider nicht! Deshalb überprüfe ich die Spalte auf die Hintergrundfarbe, erst dann wird die Umrandung eingefügt - sehr umständlich)
For j = 8 To 20
For k = 31 To 46
Application.ScreenUpdating = False
If Cells(34, j).Interior.ColorIndex = 15 Then
With Cells(k, j)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End If
Next k
Next j
Application.ScreenUpdating = True
End Sub
Wäre klasse, wenn Ihr Euch mal mein Amateurmakro durchschaut, wahrscheinlich gibt es wesentlich einfachere Möglichkeiten!
Danke im Voraus
Chris