Dividir valores en varias filas si supera un máximo
Tengo una tabla con una nómina de pagos, con varias columnas de datos y una columna con un monto a pagar, lo que pasa es que necesito separar en las filas que corresponda los valores que superen los 5.000.000 a pagar siempre que no sean del Banco Santander.
Ej: En la siguiente imagen hay 5 valores que no son del Banco Santander (37), por lo tanto esos debemos dividirlos en valores máximos de 5.000.000 sin perder el dato del proveedor, n° cuenta, etc.
Quedando de la siguiente manera:
2 Respuestas
Prueba la siguiente macro. Tus datos en la hoja "NÓMINA PAGO". Los resultados en la "Hoja2"
Sub Dividir_Valores()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim a As Variant, b As Variant, c As Variant
Dim i As Long, j As Long, k As Long, m As Long, n As Long, p As Long
Dim dic As Object
Dim div As Long, monto As Long, sumMonto As Long
'
Set sh1 = Sheets("NÓMINA PAGO")
Set sh2 = Sheets("Hoja2")
Set dic = CreateObject("Scripting.Dictionary")
div = 5000000
'
a = sh1.Range("A2:I" & sh1.Range("H" & Rows.Count).End(3).Row).Value
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
ReDim c(1 To UBound(a, 1) * 1000, 1 To UBound(a, 2))
'
For i = 1 To UBound(a)
If a(i, 5) <> 37 And a(i, 8) > div Then
If Not dic.exists(a(i, 5)) Then
j = j + 1
dic(a(i, 5)) = j
For k = 1 To UBound(a, 2)
b(j, k) = a(i, k)
Next
Else
j = dic(a(i, 5))
b(j, 8) = b(j, 8) + a(i, 8)
End If
Else
j = j + 1
For k = 1 To UBound(a, 2)
b(j, k) = a(i, k)
Next
End If
Next
'
p = 0
For i = 1 To j
If b(i, 5) <> 37 And b(i, 8) > div Then
m = Int(b(i, 8) / div)
If m < (b(i, 8) / div) Then m = m + 1
sumMonto = b(i, 8)
'
For n = 1 To m
If sumMonto > div Then
sumMonto = sumMonto - div
monto = div
Else
monto = sumMonto
End If
p = p + 1
For k = 1 To UBound(b, 2)
c(p, k) = b(i, k)
Next
c(p, 8) = monto
Next
'
Else
p = p + 1
For k = 1 To UBound(b, 2)
c(p, k) = b(i, k)
Next
End If
Next
sh2.Range("A2:I" & Rows.Count).ClearContents
sh2.Range("A2").Resize(p, UBound(c, 2)).Value = c
End Sub
Dante Amor muchas gracias!!!!!!
Funciona perfecto, lo que sí, como puedo hacer que en la hoja 2, o "Resultados" que es como le puse yo, ¿estén todas las columnas de la tabla de trabajo? de la columna A hasta la M.
Respecto a tu pregunta de la cta de destino, es la la misma en la imagen puse valores al azar, únicamente para no publicar datos reales.
Saludos,
o incluso Dante Amor si no es mucho pedir, sería ideal que todos lo obtenido pueda ser trapazado directamente a otro libro Excel.
No lo he probado, pero revisa lo siguiente:
Cambia la I por la M
a = sh1.Range("A2:I" & sh1.Range("H" & Rows.Count).End(3).Row).ValueAsí:
a = sh1.Range("A2:M" & sh1.Range("H" & Rows.Count).End(3).Row).Value
Funciona Dante Amor , ahora lo que sí en la hoja de resultado únicamente arroja el resultado de 5 filas.
Más abajo que no tienen relación con el resultado también.
También cambia en esta línea la M
Sh2.Range("A2:I" & Rows. Count). ClearContentsPor:
Sh2.Range("A2:M" & Rows. Count). ClearContents
