Komplexer Durchlauf von Bereichen

Hallo an alle,
ich habe folgendes Problem und hoffe, dass ihr mir helfen könnt:
Ich habe einen zusammenhängenden Tabellenbereich mit Daten (z.B. A1:G3).
Aus diesem Bereich möchte ich einzelne kleinere Bereiche markieren (nicht nur einzelne Zellen) die sich eventuell auch in der Zeile überschneiden (z.B. Teilbereich-1 A1:B2 und Teilbereich-2 D2:D3 --- Zeile 2 in beiden Teilbereichen). Als nächstes sollen die Daten aus diesen Bereichen entfernt werden (.clear) und die Zellen mit Daten rechts neben den gelöschten Bereichen sollen nach links verschoben werden, so dass keine Lücke entsteht.
Ich hoffe die Erklärung ist nicht zu verworren. Vielleicht erklärt es ein Bild besser. Dann bitte posten und ich erstelle eins.
Ich habe schon einen meiner Meinung nach guten Code verfasst der auch alles richtig macht nur eins ist nicht nach meinen Wünschen: die Abarbeitung der FOR-EACH-NEXT-Schleife, die ich zum ansprechen der einzelnen Teilbereiche verwende, verläuft in der Reihenfolge, in der ich die Markierung getätigt habe. Wenn sich Bereiche in Zeilen überschneiden (wie oben beschrieben), darf der Teilbereich mit "geringerer" Spaltennummer nicht zuerst abgearbeitet werden, da sonst im zweiten Bereich die Daten verschoben sind (durch das Vorrücken um keine Lücke zu haben) und dann falsche Daten gelöscht werden.
Wenn da jemand Rat weiß, wäre ich sehr dankbar.
Im Prinzip muss in meinem komplexen Code irgendwo noch hinein, dass er mit der höchsten Spaltennummer zuerst beginnen muss und dann rückwärts gehen.
Aber langsam weiß ich keinen Rat mehr. Wenn nötig setze ich den Code auch rein, aber ich möchte nicht vorher andere Ideen beeinflussen.
Meine Notlösung wäre, erstmal die Bereiche zu löschen und anschließend nochmal durchlaufen und die Daten von rechts nach links verschieben. Schön wäre es aber in einem Abwasch.
Vielen Dank schonmal im Voraus
Euer fleißiger Leser Chris

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Code dafür ist wie folgt:

Dim Act As Range
Dim Erste_Spalte As Long
Dim Letzte_Spalte As Long
Dim Anzahl_Spalten As Long
Dim Erste_Zeile As Long
Dim Letzte_Zeile As Long
Dim Erste_Zeile_Check As Long
Dim Letzte_Zeile_Check As Long
Dim b As Integer
Dim c As Integer
Dim bb As Integer
For Each Act In Selection.Areas
Erste_Spalte = Act.Column
Letzte_Spalte = Act.Column + Act.Columns.Count - 1
Anzahl_Spalten = Act.Columns.Count
'nachfolgende Prüfung (gerade oder ungerade Zeile) ist nicht relevant für mein Problem
Erste_Zeile_Check = Act.Row
Letzte_Zeile_Check = Act.Row + Act.Rows.Count - 1
If Erste_Zeile_Check Mod 2  0 Then
Erste_Zeile = Act.Row - 1
Else
Erste_Zeile = Act.Row
End If
If Letzte_Zeile_Check Mod 2 = 0 Then
Letzte_Zeile = Act.Row + Act.Rows.Count '-1 und +1
Else
Letzte_Zeile = Act.Row + Act.Rows.Count - 1
End If
'Prüfung Ende
b = Erste_Zeile - 1
Act.Clear
If Erste_Zeile Mod 2  0 Then
'Zellen über Teilbereich=>Clear
Range(Cells(Erste_Zeile, Erste_Spalte), Cells(Erste_Zeile, Letzte_Spalte)).Clear
End If
If Letzte_Zeile Mod 2 = 0 Then
'Zellen unter Teilbereich=>Clear
Range(Cells(Letzte_Zeile, Erste_Spalte), Cells(Letzte_Zeile, Letzte_Spalte)).Clear
End If
'Definition vom Ende des Zeilendurchlaufs eines Teilbereichs
If Letzte_Zeile_Check Mod 2  0 Then
bb = Act.Row + Act.Rows.Count - 1
Else
bb = Act.Row + Act.Rows.Count
End If
'Ende Definition
'Beginn Zeilendurchlauf eines Teilbereichs
Do
b = b + 1
'Prüfung ob Zelle rechts daneben der Letzten Spalte des Teilbereichs Daten enthält
If Cells(b, Letzte_Spalte + 1)  "" Then
c = Letzte_Spalte
'Datensätze von rechts nach links übernehmen (Datensatz für Datensatz)
Do
c = c + 1
Cells(b, c - Anzahl_Spalten) = Cells(b, c)
Loop Until Cells(b, c) = ""
'übernommene Datensätze aus alter Zelle entfernen
Range(Cells(b, c - Anzahl_Spalten), Cells(b, c - 1)).Clear
End If
Loop Until b = bb 'Act.Row + Act.Rows.Count - 1
Next Act

Beliebteste Forumthreads (12 Monate)

Komplexer Durchlauf von Bereichen

30 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

30
Beiträge zum Forumthread

Beiträge zu diesem Forumthread