retoque macro

[speed_methal]

Buenas tengo un macro que me pasó Greg Truby para intercalar datos de dos columnas. El macro es

Sub Intercalar()
    Const c_strAddrSource1 As String = "A2:A1752"
    Const c_strAddrSource2 As String = "B2:B1751"
    Const c_strAddrTarget As String = "E10"
 
    Dim rngSrce1 As Excel.Range, rngSrce2 As Excel.Range, _
        rngSrceCell1 As Excel.Range, rngSrceCell2 As Excel.Range, _
        rngTargetCell As Excel.Range
 
 
    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

resulta que a la hora de definir los rangos de las columnas los meto a pelo

Const c_strAddrSource1 As String = "A2:A1752"
Const c_strAddrSource2 As String = "B2:B1751"

y puesto que de unas hojas a otras el límite inferior varía, me gustaría saber si se puede definir de tal manera que el límite inferior sea la última celda con datos para que la misma macro me sirva para los distintas hojas.

Me estoy iniciando en VBA de forma autodidacta, he intentado introducir

Const c_strAddrSource1 As String =Range("A2", Range("A2").End(xlDown)).Select

que selecciona hasta la última celda no vacía, pero me tira un mensaje de error diciendo que se ha de definir como una constante.
Alguna idea?
Gracias por adelantado

 

[mailmaster]

En una primera aproximacion, habria que depurar mas (mira la ayuda de range, currentregion, pej) bastaria con no definir como const los rangos, definelos como string.

 

[mjrofra]

....
Me estoy iniciando en VBA de forma autodidacta, he intentado introducir

Const c_strAddrSource1 As String =Range("A2", Range("A2").End(xlDown)).Select

que selecciona hasta la última celda no vacía, pero me tira un mensaje de error diciendo que se ha de definir como una constante.
Alguna idea?
Gracias por adelantado

Define una variable y pasa a ella la dirección:

Dim strAddrSource1 As String

strAddrSource1 = Range("A2", Range("A2").End(xlDown)).Address

Luego ya puedes usar la variable strAddrSource1 en el lugar de la constante c_strAddrSource1.

Otra opción que te puede ahorrar este paso, si vas a usar rangos variables, es asignárselos directamente a los rangos:

Sub Intercalar()

    Dim rngSrce1 As Excel.Range, rngSrce2 As Excel.Range, _
    rngSrceCell1 As Excel.Range, rngSrceCell2 As Excel.Range, _
    rngTargetCell As Excel.Range
    
    Set rngSrce1 = [COLOR="Blue"]Range("A2", Range("A" & Rows.Count).End(xlUp))[/COLOR]
    Set rngSrce2 = [COLOR="Blue"]Range("B2", Range("B" & Rows.Count).End(xlUp))[/COLOR]
    Set rngSrceCell1 = [COLOR="Blue"]rngSrce1.Range("a1")[/COLOR]
    Set rngSrceCell2 = [COLOR="Blue"]rngSrce2.Range("a1")[/COLOR]
    Set rngTargetCell = [COLOR="Blue"]Range("e10")[/COLOR]
    
    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]

Muchas gracias mjrofra es justo lo que necesitaba

 

[Greg Truby]

Bueno, la solución ofrecida por mjrofra es bastante buena y le agradezco por haber ayudado a speed. Pero la razón por la cual utilicé constantes para representar los rangos que son las fuentes era para evitar que la rutina contenga “valores secretos” enterrados en el código. Es mucho más fácil cambiar un par de contantes que aparecen en la cabeza de la rutina que andar revisando línea por línea para asegurar que uno ha cambiado todas las líneas necesarias. Así que ofrezco una solución abajo que conserva el uso de constantes.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Y actualmente por lo general uso rangos nombrados en casos así también porque si uno inserta o suprima filas o columnas las direcciones cambian y habrá que editar el macro. Pero usando rangos nombrados, se evita este problema. Aquí está el ejemplo usando constantes<o></o>

Sub Intercalar()
    Const c_strAddrSource1 As String = "A2"
    Const c_strAddrSource2 As String = "B2"
    Const c_strAddrTarget As String = "E10"
 
    Dim rngSrce1 As Excel.Range, rngSrce2 As Excel.Range, _
        rngPrimera1 As Excel.Range, rngUltima1 As Excel.Range, _
        rngPrimera2 As Excel.Range, rngUltima2 As Excel.Range, _
        rngSrceCell1 As Excel.Range, rngSrceCell2 As Excel.Range, _
        rngTargetCell As Excel.Range
 
    Set rngPrimera1 = Range(c_strAddrSource1)
    Set rngPrimera2 = Range(c_strAddrSource2)
    Set rngUltima1 = Cells(Rows.Count, rngPrimera1.Column).End(xlUp)
    Set rngUltima2 = Cells(Rows.Count, rngPrimera2.Column).End(xlUp)
    Set rngSrce1 = Range(rngPrimera1, rngUltima1)
    Set rngSrce2 = Range(rngPrimera2, rngUltima2)
    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

 

[Greg Truby]

Se me olvidó mencionar algo importante que hizo mjrofra - en vez de ir de arriba para abajo como speed hizo en su intento, él fue del fondo hacia arriba. Hacer eso es más robusto en casos donde hay riesgo de filas o celdas vacias y uno quiere estar seguro que agarre hasta la última fila.