Como dividir un rango atendiendo al valor máximo que queremos obtener

En relación a una pregunta anterior, en la que resolviste cómo dividir el valor de una celda que contiene un rango para crear una linea con cada valor único, me gustaría saber si se podría cambiar la macro para que el número que ingresemos sea el valor máximo del rango que queremos extraer (en lugar del número máximo de líneas a crear).

De forma que, si tenemos el rango 0007-1999 e ingresamos 10 como número máximo, me devuelva solo cuatro filas (correspondientes al 7, 8, 9 y 10).

Por otro lado, a veces hay más rangos en las siguientes columnas; no sé si sería posible que siga buscando rangos hacia la derecha hasta que encuentre una celda vacía.

Me estás ayudando mucho, Dante. Estoy muy agradecido.

1 Respuesta

Respuesta
1

Te anexo una nueva macro para un valor máximo. Cambié la parte de crear una nueva hoja por una hoja fija llamada "Hoja2", con la finalidad de que en cada prueba no tener que crear una nueva hoja.

Si quieres una nueva hoja, entonces, pon el apóstrofo a esta línea

Set h2 = Sheets("Hoja2")

Y se lo quitas a esta:

Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))

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 Sub

Cada macro tiene su complejidad, podrías crear una nueva pregunta, para la macro que pides de hacerlo con varias columnas.

Hola,

Fantástico, Dante. El problema es que ahora copia filas hasta el valor máximo que ingresamos independientemente del segundo valor del rango. Pero entiendo la complejidad de todo esto, te abro una nueva pregunta para este tema.

¡Gracias! 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas