leere Zellen löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Jake() Dim Adr As String, ru As String Dim i As Integer, sr As Integer Dim j As Long, laR As Long Application.ScreenUpdating = False Adr = ActiveSheet.UsedRange.Address(False, False) ru = Right(Adr, Len(Adr) - InStr(Adr, ":")) sr = Range(ru).Column For i = 1 To sr laR = Cells(Rows.Count, i).End(xlUp).Row For j = laR To 1 Step -1 If Cells(j, i).Text = "" Then Cells(j, i).Delete Shift:=xlUp End If Next j Next i Application.ScreenUpdating = True End Sub

Hallo,
erstmal vielen Dank für eure Mühe. Klappt auch ganz gut, nur das eine oder andere Problemchen gibt's dann doch noch. Habe das auch schon in meiner Antwort auf Ingo geschrieben.
Also: Zunächst einmal muß ich mehrere Male den Schalter drücken, wenn ich möchte, daß die Werte alle in die höchstmögliche Reihe rutschen und zum anderen gibt's dann da immer noch das Problem mit den Zellbezügen, die als Fehler erscheinen.
Ich hab mal meine Excel-Tabelle mit drangehängt. Die Zusammenführung der Spalten soll im Tabellenblatt 3 laufen, am besten ohne Verlust der Zellbezüge.
https://www.herber.de/bbs/user/9187.xls
Bitte nicht lachen, denn das Ganze ist bestimmt viel viel umständlicher gemacht als man es letztendlich hätte machen müssen.
Ist halt erst meine 2. Excel-Tabelle.
Wäre nett, wenn ihr euch das mal anschauen könntet.
Ach ja, ich hab da noch mal ein zweites Makro mit drangehängt, welches ich im Internet gefunden hab. Es nennt sich "verdichten". Könnte man das vielleicht irgendwie anpassen?

Die Datei https://www.herber.de/bbs/user/9188.xls wurde aus Datenschutzgründen gelöscht

Viele Grüße vom
Jake.

Sub Jake2() Dim i As Integer Dim j As Long, laR As Long Application.ScreenUpdating = False Sheets("Tabelle3").Range("A7:X36").SpecialCells(xlCellTypeVisible).Copy With Sheets("Tabelle2") .Range("A7").PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False For i = 1 To 16 laR = .Cells(Rows.Count, i).End(xlUp).Row If laR < 7 Then laR = 7 For j = laR To 7 Step -1 If .Cells(j, i).Text = "" Then .Cells(j, i).Delete Shift:=xlUp End If Next j Next i Application.Goto Reference:=.Range("A1"), Scroll:=True End With Application.ScreenUpdating = True End Sub

Hallo Jake,
auch die wichtige Information, dass die Anzahl betroffener Spalten und Zeilen variieren kann, hast Du uns/mir vorenthalten.
Dies bedeutet wiederum einen erhöhten nachträglichen Programmieraufwand, den ich Dir in Rechnung stellen werde.
Spaß beiseite: Du brauchst an dem nachstehenden Makro nichts mehr verändern es findet die Größe des relevanten Zellbereiches selbsttätig heraus. Einzig die Zelle "A7" ist als Ausgangspunkt in beiden Tabellenblättern (Quelle und Ziel) festgelegt.
Du musst auch keinen Zellbereich markieren. Es spielt auch keine Rolle, von welchem Blatt aus das Makro gestartet wird.


Sub Jake3()
Dim Adr As String
Dim i As Integer, laC As Integer
Dim j As Long, laR As Long
Application.ScreenUpdating = False
With Sheets("Tabelle3")
On Error Resume Next
Adr = .Cells(.Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row, _
.Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column).Address(0, 0)
On Error GoTo 0
If Adr = "" Then Exit Sub
.Range("A7:" & Adr).SpecialCells(xlCellTypeVisible).Copy
End With
With Sheets("Tabelle2")
.Range("A7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
On Error Resume Next
laC = .Cells.Find("*", .Range("A1"), , , xlByColumns, xlPrevious).Column
On Error GoTo 0
If laC = 0 Then Exit Sub
For i = 1 To laC
laR = .Cells(Rows.Count, i).End(xlUp).Row
If laR < 7 Then laR = 7
For j = laR To 7 Step -1
If .Cells(j, i).Text = "" Then
.Cells(j, i).Delete Shift:=xlUp
End If
Next j
Next i
Application.Goto Reference:=.Range("A1"), Scroll:=True
End With
Application.ScreenUpdating = True
End Sub

Gruß
WernerB.

Beliebteste Forumthreads (12 Monate)

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread