Liste automatisch ergänzen lassen

Bitte, bitte helft mir!
Hallo ihr Lieben!
Ich habe schon wieder einmal ein großes Problem und brauche Eure super Hilfe:
Ich habe eine aufsteigende Liste mit Zahlencodes, die durch Überschriften ergänzt werden muss. z.B.
101 20
101 20
101 30
101 30
101 35
101 35
101 35
101 93
102 10
In einer zweiten Liste habe ich die entsprechenden Überschriften mit den Zahlencodes daneben, so dass man sie zuordnen könnte:
Mein Problem ist: Excel soll die 1. Liste durchgehen und sobald z.B. das erste Mal 101 20 kommt soll eine Zeile mit der entsprechenden Überschrift für 101 20 eingefügt werden. Ich weiß nicht, ob man dieses Problem überhaupt lösen kann. Bitte schreibt mir keine Makros von VBA, da ich nicht checke, wie ich die verwenden kann. Ich hab dann immer ein schlechtes Gewissen, weil ihr Euch so viel Arbeit macht und ich sie dann leider nicht benutzen kann. oder erklärt mir für einen totalen Dummie was ich Schritt für Schritt machen muss. das wäre natürlich am besten. Danke Euch allen für Eure super Hilfe. MaYa

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Titel_Einfügen() Dim ixLastCol As Integer Dim ixCol As Integer Dim ixRow As Long Dim ixLastRow As Long Dim bDoTitle As Boolean ActiveSheet.Range("A1").Activate ixLastRow = Range("A1").End(xlDown).Row + 1 ixLastCol = Val(InputBox("Anzahl Spalten eingeben:", "Titel Zeilen einfügen", 1)) If ixLastCol = 0 Then Exit Sub ActiveSheet.Rows(1).Insert For ixCol = 1 To ixLastCol Cells(1, ixCol).Value = Cells(2, ixCol).Value Next ixCol ixLastRow = ixLastRow + 1 ixRow = 2 Do While ixRow < ixLastRow bDoTitle = False For ixCol = 1 To ixLastCol If ActiveSheet.Cells(ixRow - 1, ixCol).Value <> ActiveSheet.Cells(ixRow, ixCol).Value Then bDoTitle = True Exit For End If Next ixCol If bDoTitle Then ActiveSheet.Rows(ixRow).Insert For ixCol = 1 To ixLastCol Cells(ixRow, ixCol).Value = Cells(ixRow + 1, ixCol).Value Next ixCol ixLastRow = ixLastRow + 1 ixRow = ixRow + 2 Else ixRow = ixRow + 1 End If Loop End Sub

Hallo Maya,
Das Makro fängt links oben (in der Zelle A1) an und arbeitet sich nach unten.
Es schaut nur das aktive Arbeitsblatt an.
Es beachtet KEINE 2te Liste oder ein anderes Arbeitsblatt.
Ich hab den Code ergänzt, dass
1. Die Startzeile abgefragt wird und 2. die Titelzeilen FETT dargestellt werden.


Sub Titel_Einfügen()
Dim ixLastCol As Integer
Dim ixCol As Integer
Dim ixRow As Long
Dim ixFirstRow As Integer
Dim ixLastRow As Long
Dim bDoTitle As Boolean
ixFirstRow = Val(InputBox("Ab welcher Zeile Titel einfügen:", "Titel Zeilen einfügen", 1))
If ixFirstRow = 0 Then Exit Sub
ActiveSheet.Cells(ixFirstRow, 1).Activate
ixLastRow = Cells(ixFirstRow, 1).End(xlDown).Row + 1
ixLastCol = Val(InputBox("Anzahl Spalten eingeben:", "Titel Zeilen einfügen", 1))
If ixLastCol = 0 Then Exit Sub
ActiveSheet.Rows(ixFirstRow).Insert
For ixCol = 1 To ixLastCol
Cells(ixFirstRow, ixCol).Value = Cells(ixFirstRow + 1, ixCol).Value
Range(Cells(ixFirstRow, ixCol).Address()).Font.Bold = True
Next ixCol
ixLastRow = ixLastRow + 1
ixRow = ixFirstRow + 1
Do While ixRow < ixLastRow
bDoTitle = False
For ixCol = 1 To ixLastCol
If ActiveSheet.Cells(ixRow - 1, ixCol).Value <> ActiveSheet.Cells(ixRow, ixCol).Value Then
bDoTitle = True
Exit For
End If
Next ixCol
If bDoTitle Then
ActiveSheet.Rows(ixRow).Insert
For ixCol = 1 To ixLastCol
Cells(ixRow, ixCol).Value = Cells(ixRow + 1, ixCol).Value
Cells(ixRow, ixCol).Font.Bold = True
Next ixCol
ixLastRow = ixLastRow + 1
ixRow = ixRow + 2
Else
ixRow = ixRow + 1
End If
Loop
End Sub

Gruss Hansueli

Beliebteste Forumthreads (12 Monate)

Liste automatisch ergänzen lassen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Liste automatisch ergänzen lassen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread