intercalar los datos de las filas de dos columnas

[speed_methal]

Hola a todos, resulta que necesito generar una macro con VBA para intercalar los datos de dos columnas. una de ellas empieza en la celda D2 y la otra en la E2 y la columna resultante tiene que salir en la B8. las columnas de la D2 y E2 tienen 2503 y 2502 datos respectivamente, por si es relevante.

Otra cuestión es si se puede generar otra macro para importar los datos de la columna D2 desde un archivo .txt ubicado en mi pc.

Espero me puedan ayudar. gracias de antemano.

 

[speed_methal]

He encontrado esta macro por ahí.

Sub intercalar()
Range("A2").Select
posicion = 0
While ActiveCell.Value <> ""
posicion = 1 + posicion
obj1 = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
obj2 = ActiveCell.Value2
Range("C2").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
fila1 = Row
ActiveCell.Value = obj1
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = obj2
ActiveCell.Offset(-posicion, -2).Select

Wend
Range("C2").Select
Selection.Delete
Selection.Delete

End Sub


Resulta que está programada para que las columnas a intercalar empiecen an A1 y B1.
Podría modificar mi hoja para que coincidiera con este código, de hecho lo he hecho, pero no sé por qué, pero al ser tantos datos se vuelve loco y no acaba. En cambio con pocos datos si va.
Alguien sería tan amable de modificar la macro para que haga lo que escribí en el primer post.

mil gracias.

 

[Greg Truby]

Seguro que no estoy comprendiendo bien qué es lo que quier hacer... ¿En la situación descrita, intercalar sería la misma cosa que calcular el promedio?

Si así es, entonces:

Sub muestra
     Range("B8").Formula = "=Average("D2:E2")
end sub

Le daría el resultado buscado.

 

[speed_methal]

Cierto, la explicación es un poco ambigua.

Al referirme a intercalar datos es que los datos de la columna D, que empiezan en la fila 2, y los datos de la E aparezcan intercalados en una nueva columna que empiece en la celda B8. por ejemplo:

B D E
1
2 1 a
3 2 b
4 3 c
5 4 d
6 5 e
7 6 f
8 1 7 g
9 a 8 h
10 2 9 i
11 b ... ...


y así hasta intercalar todos los valores.

El código que encontré hacé esta función para columnas que empiezan en A1 y B1,
A B C
1
2 a 1 a
3 b 2 1
4 b
5 2

Probé a modificar mi hoja pasando mis columnas D y E para que empezasen en A1 y B1, pero no sé por qué si son pocos datos va bien, pero si son muchos, como es mi caso, se vuelve loco y no acaba nunca.

Espero haberme explicado.
Gracias

 

[speed_methal]

Vaya!! las tablas han salido de aquella manera.

intercalado de columnas: Columnas A y B tienen los datos y en C es donde se desea generar la tabla intercalada

A B C
1 2 1
3 4 2
5 6 3
- - 4
- - 5
- - 6

 

[Greg Truby]

Habrá una gran variedad de maneras de hacer esto aquí proveo una entre ellas. Y siendo sincero por lo general prefiero que la gente descubra el sendero y yo sirvo más como guía en vez de estar regalando solución. Pero hacerlo así es mucho más trabajo y hoy tengo prisa. Por eso le doy una solución sin explicación dejando a usted hacer las investigaciones sobre cómo funciona.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

Sub Intercalar()
 
    Const c_strAddrSource1 As String = "D2:D32"
    Const c_strAddrSource2 As String = "E2:E32"
    Const c_strAddrTarget As String = "B8"
 
    Dim rngSrce1 As Excel.Range, rngSrce2 As Excel.Range, _
        rngSrceCell1, rngSrceCell2, rngTargetCell
 
    Set rngSrce1 = Range(c_strAddrSource1)
    Set rngSrce2 = Range(c_strAddrSource2)
    Set rngSrceCell1 = rngSrce1.Range("a1")
    Set rngSrceCell2 = rngSrce2.Range("a1")
    Set rngTargetCell = Range(c_strAddrTarget)
 
    Do While Not Application.Intersect(rngSrce1, rngSrceCell1) Is Nothing _
    Or Not Application.Intersect(rngSrce2, rngSrceCell2) Is Nothing
 
        If Not Application.Intersect(rngSrce1, rngSrceCell1) Is Nothing Then
            rngTargetCell.Value = rngSrceCell1.Value
            Set rngTargetCell = rngTargetCell.Offset(1)
            Set rngSrceCell1 = rngSrceCell1.Offset(1)
        End If
 
        If Not Application.Intersect(rngSrce2, rngSrceCell2) Is Nothing Then
            rngTargetCell.Value = rngSrceCell2.Value
            Set rngTargetCell = rngTargetCell.Offset(1)
            Set rngSrceCell2 = rngSrceCell2.Offset(1)
        End If
 
    Loop
 
End Sub

 

[speed_methal]

Habrá una gran variedad de maneras de hacer esto aquí proveo una entre ellas. Y siendo sincero por lo general prefiero que la gente descubra el sendero y yo sirvo más como guía en vez de estar regalando solución. Pero hacerlo así es mucho más trabajo y hoy tengo prisa. Por eso le doy una solución sin explicación dejando a usted hacer las investigaciones sobre cómo funciona.<o></o>

Sub Intercalar()
 
    Const c_strAddrSource1 As String = "D2:D32"
    Const c_strAddrSource2 As String = "E2:E32"
    Const c_strAddrTarget As String = "B8"
 
    Dim rngSrce1 As Excel.Range, rngSrce2 As Excel.Range, _
        rngSrceCell1, rngSrceCell2, rngTargetCell
 
    Set rngSrce1 = Range(c_strAddrSource1)
    Set rngSrce2 = Range(c_strAddrSource2)
    Set rngSrceCell1 = rngSrce1.Range("a1")
    Set rngSrceCell2 = rngSrce2.Range("a1")
    Set rngTargetCell = Range(c_strAddrTarget)
 
    Do While Not Application.Intersect(rngSrce1, rngSrceCell1) Is Nothing _
    Or Not Application.Intersect(rngSrce2, rngSrceCell2) Is Nothing
 
        If Not Application.Intersect(rngSrce1, rngSrceCell1) Is Nothing Then
            rngTargetCell.Value = rngSrceCell1.Value
            Set rngTargetCell = rngTargetCell.Offset(1)
            Set rngSrceCell1 = rngSrceCell1.Offset(1)
        End If
 
        If Not Application.Intersect(rngSrce2, rngSrceCell2) Is Nothing Then
            rngTargetCell.Value = rngSrceCell2.Value
            Set rngTargetCell = rngTargetCell.Offset(1)
            Set rngSrceCell2 = rngSrceCell2.Offset(1)
        End If
 
    Loop
 
End Sub

Funciona de miedo. Muchisimas gracias.
Si alguna vez necesitas algo y puedo ayudarte no dudes en decírmelo.
De nuevo gracias.

 

[Greg Truby]

¡Uy! ¡Qué vergüenza! Por estar apurado se me olvidó hacer declaraciones completas y así salen siendo Varient. La forma correcta de la declaración será:

 ...
Dim rngSrce1 As Excel.Range, rngSrce2 As Excel.Range, _
rngSrceCell1 As [COLOR=blue]Excel.Range[/COLOR], rngSrceCell2 As [COLOR=blue]Excel.Range[/COLOR], _
rngTargetCell As [COLOR=blue]Excel.Range[/COLOR]
[COLOR=#0000ff]...[/COLOR]