¿Cómo adecuar una programación a un rango de fechas que puede aumentar de manera imprevista en el tiempo?

Tengo un archivo Excel en el que tengo una base grande de datos que aumenta conforme pasa el tiempo. Dicho archivo posee una programación que realiza lo que quiero que haga pero no mitiga el riesgo de que para una misma fecha se aumenten datos.

2 respuestas

Respuesta
1

Te anexo la macro para que funcione con diferentes fechas y con diferentes columnas, incluso pueden variar los códigos y los tipos de activos.

Es necesario que crees las hojas "Hoja1" y "Hoja2".

Coloca tu información en la hoja "Ranking" y el resultado quedará en la hoja "Hoja2".

Sub PesosRelativos2()
'Por.Dante Amor
    Set h0 = Sheets("Ranking")
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    h1.Cells.Clear
    h2.Cells.Clear
    '
    h0.Cells.Copy h1.[A1]
    h1.Columns("B:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    h1.Columns("A:A").Copy h1.Columns("B")
    h1.Columns("B:B").TextToColumns Destination:=h1.Range("B1"), _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        Other:=True, OtherChar:="_", _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    '
    c = "C"
    d = "D"
    ant1 = h1.Cells(6, c)
    ant2 = h1.Cells(6, d)
    j = 6
    col = h1.Cells(4, Columns.Count).End(xlToLeft).Column + 3
    letra = Evaluate("=SUBSTITUTE(ADDRESS(1," & col & ",4),""1"","""")")
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    ini = 6
    n = 0
    '
    For i = 6 To u + 1
        If ant1 <> h1.Cells(i, c) And ant2 = h1.Cells(i, d) Then
            cuantos = n
        End If
        If ant2 <> h1.Cells(i, d) Then
            fin = i - 1
            j = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            If j < 6 Then j = 6
            h1.Rows(ini & ":" & fin).Copy h2.Rows(j)
            j = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h1.Rows(ini & ":" & fin).Copy h2.Rows(j)
            h2.Range("E" & j & ":" & letra & j + cuantos - 1).FormulaR1C1 = _
                "=R[-" & n & "]C/SUM(R[-" & n & "]C5:R[-" & n & "]C" & col & ")"
            ua = h2.Range("A" & Rows.Count).End(xlUp).Row
            h2.Range("E" & j + cuantos & ":" & letra & ua).FormulaR1C1 = _
                "=RANK(R[-" & cuantos & "]C,R[-" & cuantos & "]C5:R[-" & cuantos & "]C" & col & ",0)"
            h2.Range("A" & j & ":A" & j + cuantos - 1).Replace "_PEN_", "_W_RV_", lookat:=xlPart
            h2.Range("A" & j + cuantos & ":A" & ua).Replace "_W_", "_RANK_", lookat:=xlPart
            ini = i
            n = 0
        End If
        n = n + 1
        ant1 = h1.Cells(i, c)
        ant2 = h1.Cells(i, d)
    Next
    h2.Columns("B:D").Delete Shift:=xlToLeft
    MsgBox "Pesos y ranking terminado"
End Sub

Saludos.Dante Amor

No me deja enviarte el correo por falta de espacio en tu servidor, te dejo el archivo en el siguiente enlace:

https://www.dropbox.com/s/lh2vbr1hpa4fok6/Macro-Kenji%20Moreno%20DAM3.xlsm?dl=0 

Respuesta
1

Es difícil responder acertadamente sin ver el código o saber a ciencia cierta que tarea realiza.

Si tu problema solo radica en que las macros actúan en un rango fijo, por en con instrucciones del tipo : Range("A2:H100") y necesitas que se abarque hasta el fin de datos debes utilizar esto:

ultima = Range("A" & Rows.Count).End(xlup).Row

Y luego siguiendo con el ejemplo anterior:

Range("A2:H" & ultima)

Hay otros modos de encontrar los finales de rango, aquí solo considero la col A.

Podes encontrarlos en la pag. 5 de la sección Macros de mi sitio.

Sdos.

Elsa

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas