Excel bestimmte Anzahl von Zeilen einfügen

Question

Hallo zusammen,

ich habe ein kleines Excel Problem.

Ich habe eine Excel Tabelle, in der z.B. zehn Namen stehen A1-A10, jetzt möchte ich hinter die Namen in Spalte B eine Zahl schreiben und es sollen unter dem Namen dann B-1 Zeilen mit dem gleichen Namen eingefügt werden, sodass der Name dann einmal eingetragen wird und dann z.B. als Zahl=5 und danach dann vier zusätzliche Zeilen mit demselben Namen erscheinen.

Wenn das gemacht wurde, möchte ich in Spalte C eine weitere Zahl eintragen(1-5) nach der die Namen sortiert werden sollen, heißt alle mit 1 nacheinander dann alle mit 2 usw...

Ich hoffe das war einigermaßen verständlich.

Danke schonmal für die Hilfe.

VG

Answer 1

Hallo Pollux,

keine Ahnung was du damit bezwecken willst, aber hier mal ein Code für dein Problem.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not IsArray(Target) Then 'Prüft ob nur eine Zelle markiert ist
Namensliste = "A1:" & Cells(Rows.Count, 1).End(xlUp).Address(0, 0) 'Bezug der gesamten Liste
If Target.Column = 2 Then 'Prüft ob Änderung in Spalte B erfolgt isst
AnzVorhanden = Application.CountIf(Range(Namensliste), Cells(Target.Row, 1)) 'Wie oft der aktuelle Name bereits vorkommt
If AnzVorhanden < Target Then 'Wenn Vorkommen weniger als Wunschanzahl
Einfügebereich = Range(Cells(Target.Row + 1, 1), Target.Offset(Target - AnzVorhanden, -1)).Address(0, 0) 'Bezug zum Einfügen
Application.EnableEvents = False
Range(Einfügebereich).EntireRow.Insert 'fügt ein
Range(Einfügebereich).Value = Cells(Target.Row, 1) 'füllt Namen auf.
Application.EnableEvents = True
ElseIf AnzVorhanden > Target Then 'Wenn Vorkommen mehr als Wunschzahl
Application.ScreenUpdating = False
For i = AnzVorhanden To Target + 1 Step -1
Set n = Range(Namensliste).Find(Cells(Target.Row, 1), LookIn:=xlValues, SearchDirection:=xlPrevious)
If Not n Is Nothing Then
If n.Row = Target.Row Then
Set n = Range(Namensliste).FindPrevious(n)
End If

Application.EnableEvents = False
n.EntireRow.Delete
Application.EnableEvents = True
End If
Next i
Application.ScreenUpdating = True
End If
ElseIf Target.Column = 3 Then
Range(Range(Namensliste), Cells(1, Columns.Count)).Sort _
Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("A1"), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
End If
End If

End Sub

Öffne den VBA-Editor (Alt+F11) und füge den Code in das Tabellenmodul ein, in welchem deine Daten stehen.

Mit dem Makro kannst du nicht nur Zeilen hinzufügen, sondern auch löschen, sofern die eingegebene Zahl kleiner als die Anzahl der vorhandenen gewünschten Namen ist. Das klappt auch wenn die Daten bereits sortiert sind. Probier's aus.

Vorraussetzung ist allerdings zurzeit, dass deine Namen wirklich schon in A1 beginnen, also keine Überschriften haben.

MFG Mr. K.