Cómo establecer un valor límite en la división de un rango de valores
La siguiente macro nos permite ingresar un valor máximo para dividir un rango y copiar los valores únicos en una Hoja2.
Sub DividirValorConLimite()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("Hoja1")
'Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
Set h2 = Sheets("Hoja2")
h2.Cells.Clear
'
num = InputBox("Límite máximo del valor, o escribe 0 para todas", "INGRESA UN NÚMERO")
If num = "" Then Exit Sub
If Not IsNumeric(num) Then Exit Sub
k = 1
For i = 1 To h1.Range("B" & Rows.Count).End(xlUp).Row
valor = Split(h1.Cells(i, "B"), "-")
a = LBound(valor)
b = UBound(valor)
n = Val(valor(0))
If a = b Then
m = n
Else
m = Val(valor(1))
End If
If num > 0 Then
m = num
End If
If k + m > h1.Rows.Count Then
MsgBox "Se alcanzó el límite de la hoja"
Exit Sub
End If
For j = n To m
h2.Cells(k, "A") = h1.Cells(i, "A")
h2.Cells(k, "B") = j
k = k + 1
Next
Next
Application.ScreenUpdating = True
MsgBox "División de valores terminada", vbInformation
End SubSin embargo, se copian los valores únicos atendiendo al primer valor del rango y al máximo que hemos ingresado, independientemente del segundo valor del rango. Es decir, ante un rango 0002-0005, si ingresamos 10 como valor máximo, la macro nos devuelve 9 filas (para los valores 2, 3, 4, 5, 6, 7, 8, 9, y 10), en lugar de las 4 (para los valores 2, 3, 4, y 5) que buscábamos.
¿Se podría adaptar para que no se generen valores fuera del rango de la columna B?
Te anexo la macro para dividir hasta el número máximo o al segundo valor. Y para hacerlo por columnas.
Sub DividirValorConLimiteyColumna()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("Hoja1")
'Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
Set h2 = Sheets("Hoja2")
h2.Cells.Clear
'
num = InputBox("Límite máximo del valor, o escribe 0 para todas", "INGRESA UN NÚMERO")
If num = "" Then Exit Sub
If Not IsNumeric(num) Then Exit Sub
num = Val(num)
For c = 1 To h1.Cells(1, Columns.Count).End(xlToLeft).Column Step 2
k = 1
For i = 1 To h1.Cells(Rows.Count, c).End(xlUp).Row
valor = Split(h1.Cells(i, c + 1), "-")
n = Val(valor(0))
If LBound(valor) = UBound(valor) Then
m = n
Else
m = Val(valor(1))
End If
If num > 0 And num < m Then
m = num
End If
If k + m > h1.Rows.Count Then
MsgBox "Se alcanzó el límite de la hoja"
Exit Sub
End If
For j = n To m
h2.Cells(k, c) = h1.Cells(i, c)
h2.Cells(k, c + 1) = j
k = k + 1
Next
Next
Next
Application.ScreenUpdating = True
h2.Select
MsgBox "División de valores terminada", vbInformation
End Sub
Sencillamente genial, Dante.
Funciona a la perfección.
Abro otra pregunta para ver si la macro pudiera buscar rangos hacia la derecha hasta que encuentre una celda vacía.
¡MUCHAS GRACIAS POR TODO!
Saludos,
Roberto
