VBA Rahmenlinie einfügen

Hallo zusammen,
ich habe eine Frage.
Ich habe eine Excel Tabelle, in der die Zeilen- und Spaltenanzahl variiert.
Ich möchte nun ein VBA anwenden, welches folgendes ausführt:
In Spalte A soll immer wenn ein Eintrag (Nummer) steht über dieser Nummer die Rahmenlinie (oben) automatisch bis zur letzten Spalte (variabel) eingefügt werden.
In Spalte A ist zudem der Abstand zwischen den eingetragenen Nummern unterschiedlich. Mal 1, mal 2, mal 3, mal 4, mal 5 leere Zellen dazwischen.
Ich habe ein Beispiel Excel angehängt und dort auch schon die gewünschte obere Rahmenlinie eingefügt.
https://www.herber.de/bbs/user/112126.xlsx
Ich hoffe es kann mir jemand helfen diese Formatierung mittels VBA zu automatisieren.
Vielen vielen Dank & ich wünsche einen schönen Abend.
Lena

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Lena
Das geht wie folgt. Für die letzte benutzte Spalte im benutzten Bereich musst Du eine Function einbauen, die letzte Zeile kannst Du einfach ermitteln. Fertige Datei siehe unten. In der Beispieldatei Makro "Linien" aufrufen.


Function FindLetzte(mySH As Worksheet) As Range
Dim LRow As Long, LCol As Long
Dim A As Long
With mySH.UsedRange
On Error Resume Next
LRow = .Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False).Row
LRow = Application.Max(LRow, .Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious). _
Row)
If LRow = 0 Then LRow = 1
For A = .Columns(.Columns.Count).Column To .Columns(1).Column Step -1
LCol = mySH.Columns(A).Find("*", , xlValues, xlWhole, xlByRows, xlPrevious). _
Column
LCol = Application.Max(LCol, mySH.Columns(A).Find("*", , xlFormulas, xlWhole,  _
xlByRows, xlPrevious).Column)
If LCol > 1 Then: LCol = A: Exit For
Next A
If LCol = 0 Then LCol = 1
End With
Set FindLetzte = mySH.Cells(LRow, LCol)
End Function
Sub Linien()
Dim intLRow As Integer
Dim intLCol As Integer
intLRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Rows.Row
intLCol = FindLetzte(ActiveSheet).Column
For t = intLRow To 2 Step -1
If ActiveSheet.Cells(t, 1).Value  "" Then ActiveSheet.Range(Cells(t, 1), Cells(t, intLCol) _
).Borders(xlEdgeTop).LineStyle = xlContinuous
Next t
End Sub

Download:

Die Datei https://www.herber.de/bbs/user/112131.xlsm wurde aus Datenschutzgründen gelöscht

Funktioniert? Gruss Henner

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Rahmenlinie einfügen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread