Systematische Zellen-Verschiebung Fortsetzung

Clemens hat am 12.1.2010 um 21:22 Uhr eine Frage gestellt:
Systematische / synchrone Zellen-Verschiebung
Thomas und Reinhard haben (wie immer) tolle Lösungen geliefert. Ich habe diese Lösung mit InputBox Type:=8 „umgestaltet“. (Die Anregung dazu stammt sicher auch aus einem Beitrag von Thomas oder von Reinhard!)

Sub Move\_Areas3()

Dim rngZelle, rngZielbereich As Range
Dim lngZ, lngZo As Long
Dim lngS, lngSo As Long

lngSo = Selection.Column 
lngZo = Selection.Row
'o = "Original-Zelle", die verschoben werden soll

Set rngZielbereich = Application.InputBox( \_
 "Ziel-Zelle der zuerst ausgewählten Zelle markieren", , , , , , , \_
 Type:=8)

lngS = rngZielbereich.Column - lngSo
lngZ = rngZielbereich.Row - lngZo

On Error GoTo ErrorHandler

For Each rngZelle In Selection
 rngZelle.Cut Destination:=rngZelle.Offset(lngZ, lngS)
Next rngZelle

ErrorHandler:
End Sub

Mein Problem dabei: Ich wähle Zellen in folgender Reihenfolge aus: D25, B15, A3, C15, A12. Damit die Zellen an den richtigen Ort „gelangen“, muss ich wissen, dass ich D25 als erste Zelle ausgewählt habe. Ich muss für sie den richtigen neuen Ziel-Platz auswählen, damit alles seine Richtigkeit hat. D25 ist ja quasi die „aktive“ Zelle meiner Auswahl.
Ist es möglich, dass das Makro so umgeschrieben werden kann, dass die oberste, „linkeste“ Zelle zur aktiven Zelle wird, auch wenn ich meine oben genannte Reihenfolge bei der Auswahl beibehalte? Dass hier also A3 zur aktiven Zelle wird. Und dass ich dann für sie die Ziel-Zelle auswählen kann?
Ich weiss, es ist schwierig, die Frage richtig zu formulieren. Ich hoffe, dass ich sie einigermassen verständlich vorgebracht habe.
Vielen Dank für Eure Bemühungen und viele Grüsse
Niclaus

Grüezi Niclaus

Systematische / synchrone Zellen-Verschiebung
Thomas und Reinhard haben (wie immer) tolle Lösungen
geliefert. Ich habe diese Lösung mit InputBox Type:=8
„umgestaltet“.

Mein Problem dabei: Ich wähle Zellen in folgender Reihenfolge
aus: D25, B15, A3, C15, A12. Damit die Zellen an den richtigen
Ort „gelangen“, muss ich wissen, dass ich D25 als erste Zelle
ausgewählt habe. Ich muss für sie den richtigen neuen
Ziel-Platz auswählen, damit alles seine Richtigkeit hat. D25
ist ja quasi die „aktive“ Zelle meiner Auswahl.

Das nicht, aber es ist die erste die angewählt wurde und daher auch die erste Zelle in der Aufzählung der Selektion.

Ist es möglich, dass das Makro so umgeschrieben werden kann,
dass die oberste, „linkeste“ Zelle zur aktiven Zelle wird,
auch wenn ich meine oben genannte Reihenfolge bei der Auswahl
beibehalte? Dass hier also A3 zur aktiven Zelle wird. Und dass
ich dann für sie die Ziel-Zelle auswählen kann?

Du müsstest alle Zellen deiner Selektion durchlaufen und ermitteln welches die linke obere Ecke ist und dann basierend darauf die Verschiebung erstellen.

Oder aber zu lässt nur die ‚führende‘ Zelle markiert und lässt die anderen entsprechend folgen:

Sub Move\_Areas\_tr2()

Dim rngZelle As Range
Dim rngZielbereich As Range
Dim rngDummy As Range
Dim lngZ As Long
Dim lngS As Long

 Set rngDummy = Selection
 Selection(1).Select

 Set rngZielbereich = Application.InputBox( \_
 "Ziel-Zelle der zuerst ausgewählten (jezte aktiven) Zelle markieren", , , , , , , \_
 Type:=8)

 lngS = rngZielbereich.Column - Selection(1).Column
 lngZ = rngZielbereich.Row - Selection(1).Row

 On Error GoTo ErrorHandler
 rngDummy.Select

 For Each rngZelle In Selection
 rngZelle.Cut Destination:=rngZelle.Offset(lngZ, lngS)
 Next rngZelle

ErrorHandler:
End Sub

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

Grüezi Thomas

Du müsstest alle Zellen deiner Selektion durchlaufen und
ermitteln welches die linke obere Ecke ist und dann basierend
darauf die Verschiebung erstellen.

Genau das ist es! Da steht der Ochs am Berg und macht so etwas:

lngSo = 20000000: lngZo = 20000000
For Each rngZelle In Selection
 lngS = rngZelle.Column
 lngZ = rngZelle.Row
 If lngS 
Du wirst lachen, wenn Du so ein Konstrukt siehst, aber es haut hin!
Vielen Dank und Grüsse
Niclaus

Ist es möglich, dass das Makro so umgeschrieben werden kann,
dass die oberste, „linkeste“ Zelle zur aktiven Zelle wird,
auch wenn ich meine oben genannte Reihenfolge bei der Auswahl
beibehalte?

Hallo Niclaus,

angenommen du hast C5,F2,D7 markiert, was ist jetzt für dich die LINKE obere Ecke?
F2? C2?

Gruß
Reinhard

angenommen du hast C5,F2,D7 markiert, was ist jetzt für dich
die LINKE obere Ecke?
F2? C2?

Grüezi Reinhard
Für mich ist es die erste (oberste) markierte Zelle in der „linkesten“ Spalte. Hier also C5. Für mich ist es nicht so sehr die „Ecke“.
Gruss und Dank
Niclaus

angenommen du hast C5,F2,D7 markiert, was ist jetzt für dich
die LINKE obere Ecke?
F2? C2?

Für mich ist es die erste (oberste) markierte Zelle in der
„linkesten“ Spalte. Hier also C5. Für mich ist es nicht so
sehr die „Ecke“.

Grüezie Niclaus,

du willst C5? Bei deinem Code kommt aber C2 heraus!

Sub tt()
Range("C5,F2,D7").Select
Dim lngS, lngZ, rngZelle, lngSo, lngZo
lngSo = 20000000: lngZo = 20000000
For Each rngZelle In Selection
 lngS = rngZelle.Column
 lngZ = rngZelle.Row
 If lngS 

Gruß
Reinhard

Grüezi Niclaus

Du müsstest alle Zellen deiner Selektion durchlaufen und
ermitteln welches die linke obere Ecke ist und dann basierend
darauf die Verschiebung erstellen.

Genau das ist es! Da steht der Ochs am Berg und macht so
etwas:

lngSo = 20000000: lngZo = 20000000
For Each rngZelle In Selection
lngS = rngZelle.Column
lngZ = rngZelle.Row
If lngS
Du wirst lachen, wenn Du so ein Konstrukt siehst, aber es haut
hin!

Nö, das lacht niemand - ohne Schleife über alle Zellen der Selection geht das nicht und zwischengespeichert werden müssen die Daten ja auch.

Die einzige Frage der Entscheidung ist dann halt bei speziellen Markierungen wie B1 und A2 welches denn dann die linke obere Zelle ist, aber das ist eine Entscheidung, die Du treffen musst.

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -

Grüezie Niclaus,

wie wäre es damit:

Tabelle1:

Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
Dim Kurz() As String, N As Integer, NN As Integer, tmpN As String
Dim Zelle, rngZelle
On Error GoTo Ende
Kurz = Split(Selection.Address, ",")
For N = LBound(Kurz) To UBound(Kurz)
 For NN = LBound(Kurz) To N
 If Range(Kurz(NN)).Row \> Range(Kurz(N)).Row Or Range(Kurz(NN)).Row = Range(Kurz(N)).Row And Range(Kurz(NN)).Column \> Range(Kurz(N)).Column Then
 tmpN = Kurz(NN)
 Kurz(NN) = Kurz(N)
 Kurz(N) = tmpN
 End If
 Next
Next
Application.EnableEvents = False
Range(Join(Kurz, ",")).Select
Ende:
Application.EnableEvents = True
End Sub

Modul1

Sub Verschiebe()
Dim Kurz, K As Integer, Z As Long, S As Long, Zelle, rngZelle As Range
On Error GoTo Ende
Set Zelle = Application.InputBox(Prompt:="Wohin? (EINE Zelle markieren)", \_
 Title:="Verschiebebahnhof", Type:=8)
Z = Zelle.Row - Selection(1).Row
S = Zelle.Column - Selection(1).Column
For Each rngZelle In Selection
 rngZelle.Cut Destination:=rngZelle.Offset(Z, S)
Next rngZelle
Ende:
End Sub

Gruß
Reinhard

Grüezie Niclaus,

mal ein andrer Ansatz, noch nicht zu Ende gedacht, gecodet, getestet.
Hintergrund ist, ein Bild der selektierten zellen an die richtige Position zu schieben.
Was noch fehlt ist, nach der Verschiebung das Bild wieder in Zellwerte zu verwandeln.

Tabelle1:

Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
Dim Zelle As Range
If Selection.Areas.Count 

 Modul1:



    Sub Verschieben()
    Dim S As Shape
    If Selection.Areas.Count 
    
    Gruß
    Reinhard