Excel 2010 Makro - Zellen löschen

Hi Leute,

ich hoffe mal ihr könnt mir weiterhelfen :smile: ich habe ein Excelfile (wurde aus XML importiert) in welchem ich ca. 60 Spalten und 200 Zeilen gefüllt habe. Das Problem ist nun, dass ich z.B. folgenden Aufbau habe

Spalte 1 - Spalte 2 - Spalte 3 - Spalte 4
a - b - c - d
a - b - -

    • f - g
  • r - t -

d.h. nicht jede Zelle in jeder Zeile hat einen Inhalt.
Die Anforderungen ist nun, dass immer alles links beginnt und leere Zellen entfernt werden:

Spalte 1 - Spalte 2 - Spalte 3 - Spalte 4
a - b - c - d
a - b - -
f - g - -
r - t - -

Ich hoffe, ich konnte mich verständlich erklären :smile: Danke für eure Hilfe

Grüezi Flacke

Spalte 1 - Spalte 2 - Spalte 3 - Spalte 4
a - b - c - d
a - b - -

    • f - g
  • r - t -

d.h. nicht jede Zelle in jeder Zeile hat einen Inhalt.
Die Anforderungen ist nun, dass immer alles links beginnt und
leere Zellen entfernt werden:

Spalte 1 - Spalte 2 - Spalte 3 - Spalte 4
a - b - c - d
a - b - -
f - g - -
r - t - -

Ich gehe davon aus, dass deine Daten in A1 beginnen und es keine vollständig leeren Zeilen oder Spalten gibt.

Dann kannst Du die folgende VBA-Zeile laufen lassen und deine Werte sollten korrekt sein, sofern die als leere erscheinenden Zellen wirklich leer sind:

Sub Makro1()
 Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End Sub

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

Sorry aber bei Excel kann ich leider nicht helfen. Viel Glück

Hallo,

funktioniert wunderbar :smile: genau das habe ich gesucht, bin jetzt echt schon einen großen Schritt weiter richtung Lösung.

Ich hätte noch eine Frage: da ich hier Daten aus XML importiere, habe ich gesehen, dass man nach dem Iport im Tag „Tabellentools“ unter „Tools“ die Funktionen „Duplikate entweren“ und „In Bereich konvertieren“ verwenden kann. Diese beiden Funktionen würden mir sehr helfen, allerdings finde ich keinen Aufruf über VBA um diese zu starten.
Gibt es hierfür vielleicht auch eine Lösung? Wäre echt super.

Thx schon mal aber für die bisherige Hilfe

Hi Flacke,
bin leider beruflich gerade in Mexico, das sollte aber mit einem einfachen Makro problemlos machbar sein.
Kannst du Makros programmieren?
Gruß
Mario

Hallo
Ja, da es eine einmalige aktion ist, empfehle ich Dir das Ganze in einem normalen Texteditor zu unternehmen. Dort gibt es die möglichkeit von Suchen und ersetzten. Ggf. musst Du vor die 200 Einträge einfach ein alfanumerisches Zeichen Setzten, damit erkannt wird was zu löschen ist. Danach impotiere das Ganze wieder nach Excel.
Du kannst dies mit der Kopier- und Einfügefunktion abdecken.
Grüsse Sebastian

Grüezi Flake

funktioniert wunderbar :smile: genau das habe ich gesucht, bin
jetzt echt schon einen großen Schritt weiter richtung Lösung.

Fein, das freut mich sehr :smile:

Ich hätte noch eine Frage: da ich hier Daten aus XML
importiere, habe ich gesehen, dass man nach dem Iport im Tag
„Tabellentools“ unter „Tools“ die Funktionen „Duplikate
entweren“ und „In Bereich konvertieren“ verwenden kann. Diese
beiden Funktionen würden mir sehr helfen, allerdings finde ich
keinen Aufruf über VBA um diese zu starten.
Gibt es hierfür vielleicht auch eine Lösung?

Starte mal den Makro-Recorder und zeichne die oben genannten Schritte damit mal auf.
Der so festgehaltene Code sollte dir dann weiterhelfen.

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

soweit war ich auch schon :smile: allerdings zeichnet es hier gar nichts auf :confused: bzw. nichts was brauchwar wäre

Grüezi Flacke

soweit war ich auch schon :smile: allerdings zeichnet es hier gar
nichts auf :confused: bzw. nichts was brauchwar wäre

Hmmm, irgendwas mit .RemoveDuplicates müsste dabei aber rauskommen.

Und warum willst Du die schöne Liste/Tabelle in einen normalen Bereich umwandeln? Das Listen/Tabellen-Format hat einige Vorteile die ich nicht unterschätzen würde…

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

ich muss den Bereich umwandeln, da sonst das Entfernen Doppelter Zeilen nicht funktioniert, bzw. alles nach links verschieben funktioniert auch nicht und dies ist für mich sehr wichtig.

mfg

Hi,

kein Problem. Bin schon dabei dies mit Makros zu machen, aber ein anderer User hat mir hier bereits weitergeholfen.

Danke trotzdem

Hi,

Sorry kann erst jetzt antworten.
wennst noch hilfe brauchst.
helfe ich gerne!

Gruß fred

Hallo Flacke,

hier ein ensprechendes Makro das leere Zelle in den Zeilen löscht und die Inhalte nach links verschiebt.

Gruß
Franz

Sub LeerzellenNachLinks()

 Dim rngBereich As Range, Zelle As Range
 Const bolLeerStrings = True 'bei False werden Zellen mit Leerstrings nicht gelöscht
 On Error Resume Next
 With ActiveSheet
 Set rngBereich = .Range(.Cells(1, 1), .Cells.SpecialCells(xlCellTypeLastCell))
 End With
 If bolLeerStrings = True Then
 For Each Zelle In rngBereich
 If Not IsEmpty(Zelle) And Zelle = "" Then Zelle.ClearContents
 Next
 End If
 rngBereich.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftToLeft
End Sub

Hallo Flacke, so in etwa?

Sub LeereLoeschen()

ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Select

Selection.Delete Shift:=xlUp

End Sub
Gruß Ulli!

Hallo Flacke,

hier mein Lösungsvorschlag (erstellt unter Excel2003):

Sub ausricht()
Dim spalten As Integer
Dim Zeilen As Integer
Dim Inhalt As String
Dim y As Integer
Dim x As Integer
'Anzahl Zeilen ermitteln
Zeilen = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Anzahl Spalten ermitteln
spalten = ActiveSheet.UsedRange.Columns.Count
'Schleife für Spaltendurchlauf setzen
Do While spalten > 0
'Schleife für Zeilendurchlauf setzen
For y = 1 To Zeilen
'ist Zelle leer?
If Cells(y, spalten).Value = „“ Then
'leere Zelle markieren
ActiveSheet.Cells(y, spalten).Select
'wenn Zelle leer, dann löschen und kompletten
'Zeileninhalt eine Stelle nach links verschieben
Selection.Delete Shift:=xlToLeft
'Schleife Ende
End If
'in nächster Zeile weitersuchen
Next y
'in nächster Spalte weitersuchen
spalten = spalten - 1
Loop
End Sub

Gruß Hugo

Hallo Flacke,

versuche mal folgendes VAB-Script:

Sub einrücken()
LZ1 = [A65536].End(xlUp).Row
LZ2 = [B65536].End(xlUp).Row
LZ3 = [C65536].End(xlUp).Row
LZ4 = [D65536].End(xlUp).Row
Range(„IV1“).Value = LZ1
Range(„IV2“).Value = LZ2
Range(„IV3“).Value = LZ3
Range(„IV4“).Value = LZ4

LZ = WorksheetFunction.Max(Range(„IV1:IV4“))

Range(„IV1:IV4“).Select
Selection.ClearContents
Range(„A1“).Select

For i = 1 To LZ
wert = Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value
Rows(i).Select
Selection.ClearContents

For j = 1 To 4
Cells(i, j).Value = Mid(wert, j, 1)
Next j

Next i
End Sub

Feedback wäre schön.
Gruß,
Ptonka

Hallo Flacke,
das folgende Makro löst Dein Problem. Bei dem Beispielmakro wird davon ausgegangen, dass 2 Tabellen vorhanden sind, bei der die zweite die gleichen Überschriften hat wie die erste, ansonsten leer ist. Außerdem ist die Überschrift in beiden Tabellen in Zeile 3 und nicht in Zeile 1. Die Beispieltabelle hat 5 Spalten und 6 Zeilen. Das musst Du Deinen Bedürfnissen gemäß umschreiben.

Sub AllesLinks()

Dim zeileweg As Integer
Dim zeilehin As Integer
Dim spalteweg As Integer
Dim spaltehin As Integer

Sheets(„Tabelle1“).Select
spaltehin = 1
For zeileweg = 4 To 9
spaltehin = 1
For spalteweg = 1 To 5

If Cells(zeileweg, spalteweg).Value „“ Then
Cells(zeileweg, spalteweg).Select
Selection.Copy
Sheets(„Tabelle2“).Select
zeilehin = zeileweg
Cells(zeilehin, spaltehin).Select
ActiveSheet.Paste
spaltehin = spaltehin + 1
Sheets(„Tabelle1“).Select

End If

Next spalteweg

Next zeileweg
Sheets(„Tabelle1“).Select
Range(„A4“).Select
End Sub

Viel Erfolg, Bodo