Macro para intercambiar valores de un rango unidimensional

Excel permite transponer con facilidad los valores de un rango. Por ejemplo, si tenemos un rango vertical de valores como éste

y queremos convertirlo en un rango horizontal, usamos Copiar Pegado Especial-Transponer



¿Pero cómo hacemos para intercambiar los valores? Una posibilidad es arrastrando las celdas mientras mantenemos apretada la tecla Mayúsculas. Pero esto puede volverse muy tedioso y hasta irritante si se trata de un número de celdas considerable. Así que la solución que propondremos será con una macro.
Lo que queremos es que dado el rango A1:A5, obtener el rango C1:C5



La macro es la siguiente (nota: el uso de esta macro es sólo para rangos unidimensionales)

Sub swap_range()
Dim rngToSwap As Range, rngTarget As Range, cell As Range
Dim iX As Long, Counter As Long, HorVert As Integer
Dim arrval()

On Error GoTo err

Set rngToSwap = Application.InputBox _
(prompt:="seleccionar el rango", Type:=8)
Set rngTarget = Application.InputBox _
(prompt:="seleccione la primer celda para pegar", Type:=8)

HorVert = Application.InputBox( _
prompt:="Horizontal = 1;Vertical = 2", Type:=1)


Counter = rngToSwap.Count

ReDim arrval(Counter)

For iX = Counter - 1 To 0 Step -1
arrval(iX) = rngToSwap(Abs(iX - Counter)).Value
Next iX

Select Case HorVert
Case 1
Range(rngTarget, rngTarget.Offset(0, Counter)).Value = arrval
Case Else
Range(rngTarget, rngTarget.Offset(Counter, 0)).Value = _
WorksheetFunction.Transpose(arrval)
End Select

err:
Exit Sub

End Sub

Definimos tres variables que el usuario debe introducir usando Application.InputBox: el rango a intercambiar, la primer celda del rango objetivo y el sentido del rango a obtener (horizontal o vertical)



No sé hasta qué punto encontrarán útil esta macro. Sencillamente, me topé con este problema en una de mis tareas lo que me llevó a escribir la macro.

Technorati Tags: MS Excel