Excel: Ich möchte Zellen von rechts nach links einrücken, wo jeweils eine Zelle frei ist. Allerdings ist in jeder Zeile woanders eine Zelle frei. Wie?
Excel Problem:
Ich habe in Zelle E1 "X" stehen und in Zelle F1 "Y". Die Zelle B1, C1, und D1 sind jeweils leer. Wie schaffe ich es, dass das "X" und "Y" jeweils nach links in die Zellen B und C rückt und nur noch D frei bleibt?
Problem ist, dass ich in der nächsten Zeile den Text z.B. "P" und "L" nicht mehr in Zelle E2 und F2 sondern in E2 und G2 stehen habe. Dies soll auch wieder nach links eingerückt werden, sodass das "P" in B2 und "L" in C2 steht.
Tipps? :(
3 Antworten
Hi,
vorweg beide folgenden Lösungen funktionieren nicht mit Formeln bzw werden eventuelle Formeln im Bereich durch deren Ergebnisse ersetzt.
- Falls VBA für dich in Frage kommt:
Sub linksran()
Dim lSpalte As Long
Dim lZeile As Long
Dim fSpalte As Long
Dim vSpalte As Long
Dim a As Long
Dim n As Long
Dim text As String
Dim StartSpalte As Long
Dim StartZeile As Long
Dim Anfangsspalte As String
Dim Anfangszeile As String
Dim Anfang As String
Dim Ende As String
'Bereich bestimmen Spalte
Anfangsspalte = InputBox("In welcher Spalte anfangen?")
If Anfangsspalte = "" Then
Anfangsspalte = 1
End If
If IsNumeric(Anfangsspalte) Then
StartSpalte = Anfangsspalte * 1
Else
StartSpalte = ActiveSheet.Range(Anfangsspalte & 1).Column
End If
Dummy = MsgBox("Bis zur letzten genutzten Spalte durchführen?", vbYesNo)
If Dummy = vbNo Then
lSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
endspalte = InputBox("Bis zu welcher Spalte, es werden auf dem Blatt " & lSpalte & " Spalten genutzt.")
If IsNumeric(endspalte) Then
lSpalte = endspalte * 1
Else
lSpalte = ActiveSheet.Range(endspalte & 1).Column
End If
Else
lSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
End If
'Bereich bestimmen Zeile
Anfangszeile = InputBox("In welcher Zeile anfangen?")
If Anfangszeile = "" Then
Anfangszeile = 1
End If
If IsNumeric(Anfangszeile) Then
StartZeile = Anfangszeile * 1
Else
StartZeile = ActiveSheet.Range(Anfangszeile & 1).Column
End If
Dummy = MsgBox("Bis zur letzten genutzten Zeile durchführen?", vbYesNo)
If Dummy = vbNo Then
lZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
endzeile = InputBox("Bis zu welcher Zeile, es werden auf dem Blatt " & lZeile & " Zeilen genutzt.")
If IsNumeric(endzeile) Then
lZeile = endzeile * 1
Else
lZeile = ActiveSheet.Range(endzeile & 1).Row
End If
Else
lZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
End If
'Sicherheitsfrage
Anfang = ActiveSheet.Cells(StartZeile, StartSpalte).Address(False, False)
Ende = ActiveSheet.Cells(lZeile, lSpalte).Address(False, False)
Dummy = MsgBox("Es werden die Zellen im Bereich " & Anfang & ":" & Ende & " nach links eingerückt. Fortfahren?", vbYesNo)
If Dummy = vbNo Then
MsgBox "abgebrochen"
Exit Sub
End If
'einrücken
On Error GoTo Errorhandler
Application.ScreenUpdating = False
Application.Calculation = xlManual
For a = StartZeile To lZeile
n = StartSpalte
fSpalte = lSpalte + 1
vSpalte = 0
x = 0
For n = StartSpalte To lSpalte
If ActiveSheet.Cells(a, n).Value = "" And fSpalte > lSpalte Then
fSpalte = n
End If
If ActiveSheet.Cells(a, n) <> "" Then
text = ActiveSheet.Cells(a, n).Value
vSpalte = n
End If
If fSpalte < vSpalte Then
ActiveSheet.Cells(a, fSpalte) = text
ActiveSheet.Cells(a, n).ClearContents
fSpalte = lSpalte + 1
vSpalte = 0
n = StartSpalte
End If
x = x + 1
If x = lSpalte * lSpalte Then
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
MsgBox "Vermutung auf unendliche Schleife, der Vorgang wurde abgebrochen"
Exit Sub
End If
Next n
Next a
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
MsgBox "Duchlauf beendet"
Exit Sub
Errorhandler:
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
MsgBox "Ein unerwarteter Fehler ist aufgetreten, der Vorgang wurde abgebrochen."
End Sub
Theoretisch wäre es hier auch möglich die Formeln zu behalten, indem man text = ActiveSheet.Cells(a, n).Value durch text = ActiveSheet.Cells(a, n).Formula ersetzt, aber man erzeugt damit sehr leicht Zirkelbezüge.
- Falls VBA keine Option ist brauchst ein Hilfsblatt auf dem du die Einträge sortierst:
In Zeile A (bereits bei der Eingabe müssen die späteren Ausgabezellen markiert sein, sonsst rechnet Excel anders) Zelle A1 und soweit du brauchst nach unten kopieren:
{=WENNFEHLER(INDEX(Tabelle1!$A1:$Z1;1;KKLEINSTE(WENN(Tabelle1!$A1:$Z1="";10^99;SPALTE(Tabelle1!$A$1:$Z1));SPALTE(Tabelle1!$A1:$Z1)));"")}
Matrixformel, geschweifte Klammern {} nicht eingeben, sondern die Eingabe über Strg+Umschalt+Enter abschließen.
Die damit entstandene Tabelle kannst du über Einfügen->Inhalte einfügen-> Werte einfügen in dein richtiges Blatt übernehmen.
Zelle / Spalte E - markieren - ausschneiden - in Zelle/Spalte B einfügen
das gleiche mit Zelle / Spalte F.
Wie wäre es, wenn Du die Werte zunächst sortierst ? Dann hast Du u.U. große Blöcke die verschoben werden können.
Moin,
Einfügen => Zellen einfügen=> Zellen nach recht verschieben ...
mit 100.000 Zeilen wird das schwierig ...
Grüße
Das geht leider nicht weil in Spalte B eine Zeile drunter anderer Text steht. Ich habe 100.000. Zeilen, sodass ich es nicht für jede manuell anpassen also ausschneiden und einfügen kann