AW: Zeilen einfügen mittels best. Zellwerte
06.04.2008 18:54:00
fcs
Hallo Howard,
hier das Makro mit den erforderlichen Anpassungen.
Ich hab auch noch bei den Formatierungen etwas gebastelt, so dass die Rahmen nur in den Spalten C bis J eingefügt werden falls erforderlich und in Spalte C die Zeilen mit den nummerierten Einträgen nicht fett formatiert werden.
Gruß
Franz
Sub ZeilenEinfuegen()
' Makro am 06.04.08 von fcs erstellt unter Excel 97 & bearbeitet von Howard unter Excel 03
Dim objWs As Worksheet
Dim bolRahmen As Boolean
Dim lngZeile As Long
Dim intAnzahl As Integer, intI As Integer
Dim strGruppe As String
Const lngZeileGrp1 As Long = 5 '1. Zeile mit einer Gruppe
Const intSpalteAnz As Integer = 6 'Nummer der Spalte mit der Anzahl
Const intSpalteGrp As Integer = 3 'Nummer der Spalte mit der Gruppe
'Format der laufenden Nr, die angehängt wird, hier 001, 002 ,003 usw.
Const strFormatNr As String = " 000"
Set objWs = Worksheets("Tabelle1")
With objWs
'Alle gruppierten Zeilen der Ebene 2 einblenden
.Outline.ShowLevels RowLevels:=2
Application.ScreenUpdating = False
'Zeilen von unten nach oben abarbeiten
For lngZeile = .Cells(.Rows.Count, intSpalteGrp).End(xlUp).Row To lngZeileGrp1 Step -1
'Prüfen ob in Spalte mit Anzahl eine Zahl eingetragen ist
If Not IsEmpty(.Cells(lngZeile, intSpalteAnz)) _
And IsNumeric(.Cells(lngZeile, intSpalteAnz)) Then
'Prüfen, ob Zeile, vor der eingefügt wird, in Spalte Anzahl leer ist. _
Diese Zeilen haben keine Rahmen und der Rahmen für die eingefügten _
Zeilen muss formatiert werden
If IsEmpty(.Cells(lngZeile + 1, intSpalteAnz)) Then
bolRahmen = True
Else
bolRahmen = False
End If
'Werte für Gruppe und Anzahl merken
strGruppe = .Cells(lngZeile, intSpalteGrp).Value
intAnzahl = .Cells(lngZeile, intSpalteAnz).Value
If intAnzahl > 1 Then
'Anzahl Leerzeilen einfügen
.Range(.Rows(lngZeile + 1), _
.Rows(lngZeile + intAnzahl)).Insert Shift:=xlShiftDown
'Eingefügte Zeilen formatieren und gruppieren
With .Range(.Cells(lngZeile + 1, 3), .Cells(lngZeile + intAnzahl, 10))
'ggf. Rahmen in Spalten C bis J formatieren
If bolRahmen = True Then
.BorderAround LineStyle:=xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
With .Borders
.Weight = xlThin
End With
End If
End With
'Zellen mit nummerierten Gruppen in Spalte C nicht fett
With .Range(.Cells(lngZeile + 1, 3), .Cells(lngZeile + intAnzahl, 3))
.Font.Bold = False
End With
'eingefügte Zeilen gruppieren
With .Range(.Rows(lngZeile + 1), .Rows(lngZeile + intAnzahl))
.Group
End With
'Gruppenbezeichnungen durchnummerieren und Werte aus Spalten D und E übernehmen
For intI = 1 To intAnzahl
.Cells(lngZeile + intI, intSpalteGrp).Value = strGruppe _
& Format(intI, strFormatNr)
.Cells(lngZeile + intI, intSpalteGrp + 1).Value = _
.Cells(lngZeile, intSpalteGrp + 1).Value
.Cells(lngZeile + intI, intSpalteGrp + 2).Value = _
.Cells(lngZeile, intSpalteGrp + 2).Value
Next
End If
End If
Next
Application.ScreenUpdating = True
End With
End Sub