¿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
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 SubSaludos.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
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