AW: Zellenaustausch möglich?
19.09.2009 14:08:45
fcs
Hallo Karsten,
ah, jetzt hab ich verstanden was du möchtest.
Hier zwei Varianten.
Variante 1 tausch die Werte für einen vorgegebenen Bereich, ausgehend von den beiden markierten Zellen.
Variante 2 ist flexibler. Der auszutauschende Bereich wird gewählt. Das Makro fragt dann nach der 1. zelle des Zielbereichs.
Gruß
Franz
Sub Inhalte_zweier_Zellen_austauschen()
Dim arr1, arr2
Dim rng1 As Range, rng2 As Range
Dim Bereich As String
Bereich = "A1:B1" 'Bereich ausgehend von den beiden markierten Zellen _
dessen Daten ausgetausch werden sollen
If Selection.Cells.Count = 2 Then
If Selection.Areas.Count = 2 Then
Set rng1 = Selection.Areas(1).Range("A1")
Set rng2 = Selection.Areas(2).Range("A1")
Else
Set rng1 = Selection.Range("A1")
Set rng2 = Selection.Range("A2")
End If
arr1 = rng1.Range(Bereich).Value
arr2 = rng2.Range(Bereich).Value
rng1.Range(Bereich) = arr2
rng2.Range(Bereich) = arr1
Else
MsgBox "Bitte nur nur 2 Zellen für Werteaustausch markieren!"
End If
Ende:
arr1 = Null: arr2 = Null
Set rng1 = Nothing: Set rng2 = Nothing
End Sub
Sub Inhalte_zweier_Zellen_austauschen_Variante()
Dim rng1 As Range, rng2 As Range
Dim Bereich As String
On Error GoTo Ende
'gewählten Zellbereich merken
Set rng1 = Selection
'Zielzelle für Werteaustasch wählen
Set rng2 = Application.InputBox(Prompt:="Bitte 1. Zelle des Zielbereichs wählen", _
Title:="Werte zwischen Zellen austauschen", _
Default:=rng1.Range("A1").Address, _
Type:=8)
arr1 = rng1.Value 'Werte des 1. Bereichs merken
'2. Bereich gemäß größe des 1.Bereichs festlegen
Set rng2 = rng2.Range("A1").Range(Cells(1, 1), Cells(rng1.Rows.Count, rng1.Columns.Count))
arr2 = rng2.Value 'Werte des 2. Bereichs merken
'Werte durchtauschen
rng1 = arr2
rng2 = arr1
Ende:
arr1 = Null: arr2 = Null
Set rng1 = Nothing: Set rng2 = Nothing
End Sub