Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
524to528
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
524to528
524to528
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Leere Spalte einfügen

Leere Spalte einfügen
02.12.2004 14:00:47
Tobias
Hallo Zusammen!
Folgendes Problem:
Ich habe eine ziemlich lange Excel-Liste. In Spalte A stehen Namen. Mehrfach untereinander der selbe Name.
Nun möchte ich in VBA ein Tool schreiben welches mir jeweils beim Wechsel zwischen 2 Namen eine freie Zelle einfügt.
Bsp.: A32 = Meier, A33 = Meier, A34 = Müller, A35 = Müller
Nun soll also zwischen Meier und Müller eine freie Zelle eingefügt werden.
Also A32=Meier, A33 = Meier A34 = LEER, A35 = Müller, A36 = Müller
Jemand ne Idee wie man das realisieren kann?
Die Tabelle geht bis A5000 oder so, per Hand wäre das sehr umständlich.
Danke für jeden Tipp!

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Leere Spalte einfügen
WernerB.
Hallo Tobias,
kannst Du damit etwas anfangen?

Sub Tobias()
Dim i As Long, laR As Long
Application.ScreenUpdating = False
laR = Cells(Rows.Count, 1).End(xlUp).Row
For i = laR To 2 Step -1
If Cells(i, 1).Text <> Cells(i - 1, 1).Text Then
Cells(i, 1).Insert Shift:=xlDown
End If
Next i
Application.ScreenUpdating = True
End Sub

Viel Erfolg wünscht
WernerB.
P.S.: Dieses Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter !
AW: Leere Spalte einfügen
02.12.2004 14:26:56
Tobias
Hallo WernerB!
Also vom Prinzip schon mal super! Hut ab!
ABER: In den Spalten B-H stehen ebenfalls Daten, die mit zu den Namen gehören und ebenfalls nach unten verschoben werden müssen.
Bsp.
A1 = Müller
B1 = Klaus
C1 = Straße
D1 = Ort
E1 = ...
Bei deiner Lösung wird nur in Spalte A jeweils eine freie nach dem Namenswechsel eingefügt, es muß aber eine komplette Zeile eingefügt werden. So dass die zusammengehörigen Daten auch zusammen bleiben.
Für einen weiteren Vorschlag wäre ich sehr dankbar!
MfG
Tobias
Anzeige
AW: Leere Spalte einfügen
02.12.2004 14:31:15
Tobias
Kommando zurück!!
So geht's:

Private Sub CommandButton1_Click()
Dim i As Long, laR As Long
Application.ScreenUpdating = False
laR = Cells(Rows.Count, 1).End(xlUp).Row
For i = laR To 2 Step -1
If Cells(i, 1).Text <> Cells(i - 1, 1).Text Then
Cells(i, 1).Insert Shift:=xlDown
Cells(i, 2).Insert Shift:=xlDown
Cells(i, 3).Insert Shift:=xlDown
Cells(i, 4).Insert Shift:=xlDown
Cells(i, 5).Insert Shift:=xlDown
Cells(i, 6).Insert Shift:=xlDown
Cells(i, 7).Insert Shift:=xlDown
Cells(i, 8).Insert Shift:=xlDown
End If
Next i
Application.ScreenUpdating = True
End Sub

Danke !!!
Anzeige
AW: Leere Spalte einfügen
WernerB.
Hallo Tobias,
in Deiner ursprünglichen Problembeschreibung wolltest Du jeweils eine Zelle (nicht Zeile) eingefügt haben.
So sind es ganze Zeilen:

Sub Tobias()
Dim i As Long, laR As Long
Application.ScreenUpdating = False
laR = Cells(Rows.Count, 1).End(xlUp).Row
For i = laR To 2 Step -1
If Cells(i, 1).Text <> Cells(i - 1, 1).Text Then
Cells(i, 1).EntireRow.Insert
End If
Next i
Application.ScreenUpdating = True
End Sub

Gruß
WernerB.
Ein letztes mal ...
02.12.2004 14:41:54
Tobias
Funktioniert einwandfrei!
Einzige "Schönheitskorrektur" wäre höchstens noch, dass erst alle Daten ab A5 gelesen werden. In A1-A3 stehen feste Werte die mit der verschiebung nichts zu tun haben.
Geht das auch?
MfG
Anzeige
AW: Ein letztes mal ...
WernerB.
Hallo Tobias,
na klar doch!
Ändere einfach in der Zeile
For i = laR To 2 Step -1
die "2" in eine "6" (ungetestet).
Gruß
WernerB.
Das wars!
02.12.2004 14:48:33
Tobias
Danke!
Klappt super!!
Hier dann nochmal die komplette VBA:

Private Sub cmd_add_free_Click()
Dim i As Long, laR As Long
Application.ScreenUpdating = False
laR = Cells(Rows.Count, 1).End(xlUp).Row
For i = laR To 6 Step -1
If Cells(i, 1).Text <> Cells(i - 1, 1).Text Then
Cells(i, 1).EntireRow.Insert
End If
Next i
Application.ScreenUpdating = True
End Sub

MfG
Tobias
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige