Zellbereiche verschieben nach Vergleich

Computer: Software & Programmierung Visual Basic
#1

Liebes Forum,

wer von euch kann mir helfen?
Ich versuche folgendes mit einem Makro zu lösen: Meine ExcelTabelle enthält mehrere Spalten mit Datumswerten. Zwischen den Datumsspalten sind ca. 4-6 Spalten mit Messwerten. Da es nicht zu jedem Datum ein Messwert gibt, möchte ich die Datumsspalten an eine „General-Datumsspalte“ in Spalte A anpassen. Und zwar so, dass alle Datumsspalten mit der ersten Spalte verglichen werden und wenn die Datumswerte ungleich sind, der gesamte Bereich zwischen den Datumsspalten in die richtige Zeile (zu dem richtigen Datum) aus Spalte A rutscht.
So sehen die Spalten aus:

Spalte A:
12.01.1990
13.01.1990
14.01.1990
…
01.12.2010

Spalte B:
13.01.1990
01.12.2010

Spalte C-E: Messwerte zu den Datumswerten aus Spalte B (in diesem Falle nur zwei Messwerte,da nur an zwei Tagen gemessen)

Spalte F: wieder Datumswerte mit anschließenden Spalten G-L Messwerte für die Datumswerte aus Spalte F

Es sollen also alle Bereiche mit ihrer Datumsspalte an die erste Datumsspalte (A) angepasst werden.
Im Beispiel müsste also der Bereich mit Datum 13.01.1990 eine Zeile nach unten rücken, um mit Spalte A in einer Zeile zu stehen. Der Bereich mit Datum 01.12.2010 müsste bis in die letzte Zeile rücken, da dieses Datum in Spalte A in der letzten Zeile steht.

Bisher habe ich das ganze für nur einen Datumsbereich versucht. Also Spalte A: Datumswerte (jeder Tag von 1990 bis heute) und in Spalte B Datumswerte (auch von 1990 bis heute, aber nicht jeder Tag). Spalte C bis G Messwerte zu Spalte B, die mit verrückt werden sollen.

Leider fügt mir mein Makro nur Leerzeilen zwischen jedes Datum ein und macht so gar nicht das was es soll :wink: Ich überprüfe die Datumsspalten zwar auf Ungleichheit, sie werden aber nicht an die richtige Stelle verschoben. Und ich weiß auch nicht, wie ich den Vergleich weiter laufen lassen, wenn die Datumswerte gleich sind und die Zeilen nicht verrückt werden müssen…:

Sub Reihen_nach_unten_verschieben()

Application.ScreenUpdating = False

Dim ZeileMax As Long
Dim intz As Long

With Worksheets(„Tabelle1“)

ZeileMax = Worksheets(„Tabelle1“).Cells(Rows.Count, 1).End(xlUp).Row

For intz = 3 To ZeileMax Step 1

If .Cells(intz, 2).Value .Cells(intz, 1).Value Then

Range(„B“ & intz + 1, „L“ & intz + 1).Select
Selection.Insert Shift:=xlDown

End If
Next intz

End With

Application.ScreenUpdating = True
End Sub

Bin sehr dankbar für jegliche Hilfe.
Beste Grüße,
Niol

Achso: Der Bereich zum Verschieben liegt also immer zwischen zwei Datumsspalten, wobei B die erste für den ersten Bereich ist.
Und wie bekomme ich das .Select weg?

Hoffentlich hab ichs einigermaßen verständlich beschrieben.

#2

Ich versuche folgendes mit einem Makro zu lösen: Meine
ExcelTabelle enthält mehrere Spalten mit Datumswerten.
Zwischen den Datumsspalten sind ca. 4-6 Spalten mit
Messwerten. Da es nicht zu jedem Datum ein Messwert gibt,
möchte ich die Datumsspalten an eine „General-Datumsspalte“ in
Spalte A anpassen.

Hallo Niol,

probiere es wie nachstehend.

Gruß
Reinhard

Option Explicit
'
Sub Einordnen()
'Wichtig ist, daß B und F usw. nach Datum aufsteigend sortiert sind
Dim Zei As Long, arrS(), S As Integer
Application.ScreenUpdating = False
arrS = Array("B", "E", "F", "L")
For S = 0 To UBound(arrS) - 1 Step 2
 For Zei = Range(arrS(S) & Rows.Count).End(xlUp).Row To 1 Step -1
 Range(arrS(S) & Zei, arrS(S + 1) & Zei).Cut Destination:=Range(arrS(S) & Application.Match(Range(arrS(S) & Zei), Columns(1), 0))
 Next Zei
Next S
hell:
If Err.Number 0 Then
 MsgBox Err.Number & Chr(10) & Err.Description & Chr(10) \_
 & "möglicherweise in " & arrS(S) & Zei
End If
Application.ScreenUpdating = True
End Sub
#3

Lieber Reinhard,

vielen Dank für die Antwort und den Lösungsvorschlag. Es klappt, wenn ich nur einen Bereich in der Tabelle habe. Also wenn es außer der Datumsspalte A (an die die anderen Datumsspalten angepasst werden) noch eine weitere Datumsspalte (zB. Spalte B) gibt funktioniert es. Sobald aber eine weitere Datumsspalte (zB. Spalte M) hinzu kommt funktioniert es leider nicht für diesen Bereich.
arrS = Array(„B“, „L“, „…“, „…“) habe ich entsprechend an meine Tabelle angepasst und aufsteigend sortiert waren die Spalten auch.

Gibt es eine Möglichkeit, es so zu machen: „Für jeder Spalte, die Datum enthält, verschiebe den Bereich bis zur nächsten Datumsspalte angepasst an erste Datumsspalte“? Dann müsste ich den Bereich nicht festlegen, denn mittlerweile habe ich gemerkt, dass er variiert…

Ebenso habe ich noch einen Laufzeitfehler 13 (Typen unverträglich) für die ersten 100 Zeilen (vermutlich), denn danach wird der Bereich richtig angepasst. Versuche gerade, herauszufinden woran das liegt. Nach Ausführen des Makros öffnete sich auch das Zirkelverweis-Popup. Möglicherweise stimmen nach dem Verschieben die Bezüge nicht mehr… da hier jedoch nur die Zahlenwerte verschoben werden sollen, müsste das zu regeln sein.

Vielen Dank nochmal!
Grüße,
niol

#4

Hallo Niol,

Es klappt, wenn ich nur einen Bereich in der Tabelle habe. Also
wenn es außer der Datumsspalte A (an die die anderen
Datumsspalten angepasst werden) noch eine weitere Datumsspalte
(zB. Spalte B) gibt funktioniert es. Sobald aber eine weitere
Datumsspalte (zB. Spalte M) hinzu kommt funktioniert es leider
nicht für diesen Bereich.

glaub ich nicht, Cod ist jetzt zweimal getestet mit XL2000.

http://www.file-upload.net/download-3027082/kwdatums…

arrS = Array(„B“, „L“, „…“, „…“) habe ich entsprechend an
meine Tabelle angepasst und aufsteigend sortiert waren die
Spalten auch.

Ach, ich glaube, aufsteigend sortiert ist gar nicht notwendig.
Die Codezeile muß so aussehen bei drei Bereichen:

arrS = Array(„B“, „E“, „F“, „L“, „M“, „R“)

B, F, M sind die Datumsspalten.

Gibt es eine Möglichkeit, es so zu machen: „Für jeder Spalte,
die Datum enthält, verschiebe den Bereich bis zur nächsten
Datumsspalte angepasst an erste Datumsspalte“? Dann müsste ich
den Bereich nicht festlegen, denn mittlerweile habe ich
gemerkt, dass er variiert…

Ich schau mal.

Ebenso habe ich noch einen Laufzeitfehler 13 (Typen
unverträglich) für die ersten 100 Zeilen (vermutlich), denn
danach wird der Bereich richtig angepasst.

Ist vielleicht ein Nebeneffekt von falschem arrS. Tritt bei mir nicht auf, wie auch Zirkelverweis usw.

Gruß
Reinhard

#5

Gibt es eine Möglichkeit, es so zu machen: „Für jeder Spalte,
die Datum enthält, verschiebe den Bereich bis zur nächsten
Datumsspalte angepasst an erste Datumsspalte“? Dann müsste ich
den Bereich nicht festlegen, denn mittlerweile habe ich
gemerkt, dass er variiert…

Hallo Niol,

probiers mal so

Sub Einordnen()
Dim Zei As Long, arrS() As Long, S As Integer
Application.ScreenUpdating = False
ReDim arrS(0) As Long
arrS(0) = 2
For S = 3 To Cells(1, Columns.Count).End(xlToLeft).Column
 If IsDate(Cells(1, S).Value) Then
 ReDim Preserve arrS(UBound(arrS) + 2) As Long
 arrS(UBound(arrS) - 1) = S - 1
 arrS(UBound(arrS)) = S
 End If
Next S
ReDim Preserve arrS(UBound(arrS) + 1) As Long
arrS(UBound(arrS)) = S - 1
For S = 0 To UBound(arrS) - 1 Step 2
 For Zei = Cells(Rows.Count, arrS(S)).End(xlUp).Row To 1 Step -1
 If IsDate(Cells(Zei, arrS(S)).Value) Then
 Range(Cells(Zei, arrS(S)), Cells(Zei, arrS(S + 1))).Cut Destination:=Cells(Application.Match(Cells(Zei, arrS(S)), Columns(1), 0), arrS(S))
 End If
 Next Zei
Next S
hell:
If Err.Number 0 Then
 MsgBox Err.Number & Chr(10) & Err.Description & Chr(10) \_
 & "möglicherweise in " & Cells(Zei, arrS(S)).Address
End If
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard