Detectar un rango dentro de una celda y duplicar la fila con los valores únicos obtenidos
Esta es muy parecida a una pregunta que me resolviste recientemente. En origen te pedía una macro para dividir valores dentro de una celda (separados por comas) para obtener una linea por cada uno de los valores únicos (manteniendo el resto de datos asociados a la linea original). La macro que me enviaste funciona genial pero ahora necesito que los datos que copie sean todos los que hay en un rango dentro de la celda.
Me explico mejor: en la primera macro, si en la celda en cuestión figuraba e.g. 12,13,14, la macro generaba tres líneas con cada valor único (fila1=12, fila2=13 y fila3=14).
Lo que necesito ahora es lo mismo pero contando los valores de un rango en esa celda e.g. Si el valor de la celda es 0012-0014, quiero obtener una fila con el valor 12, otra con 13 y otra con 14.
Respecto a tus dudas:
- ¿Puede ser que el resultado quede en otra columna o tiene que se en la misma columna?
Sí, incluso me vendría bien que el resultado se copiara en una nueva hoja.
- ¿Siempre hay rangos? Es decir aunque sea de 15 a 15 está escrito así: 15-¿15?
Sí, siempre hay rangos de cuatro dígitos e.g. 0015-0015
- ¿Siempre están separados por guión "-"?
Sí, siempre están separados por un guión.
1 respuesta
Te anexo la macro
Sub DividirValor()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
'
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
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 SubTus datos deben estar en la hoja "Hoja1".
Siempre te crea una nueva hoja y te pone los resultados.
Supongo que tienes un dato en la columna A y en la columna B tienes el rango.
Prueba y me comentas.
Saludos. Dante Amor
Hola Dante,
Funciona muy bien, el problema es que dada la cantidad de resultados, la macro da error (se ha parado poco después del millón de líneas).
Se me ocurre que podríamos limitar el número de resultados, es decir, seleccionar en un box (o algo parecido) el límite del valor e.g. Si tuviéramos el rango 0003-1999 y seleccionamos como límite "5", nos devolvería únicamente 3 filas (una para 3, otra para 4 y otra para 5) en lugar de las casi 2000.
Muchas gracias.
Saludos,
Roberto
La cantidad máxima de líneas por hoja es de 1,048,576.
Entonces, ya le agregué a la macro una ventana para que pongas el límite máximo de líneas, puedes poner el número 0, para que te haga todas las líneas sin límite.
También le agregué a la macro un validación para saber si va a llegar al final de la hoja.
Sub DividirValor()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
'Set h2 = Sheets("Hoja4")
'
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
dif = m - n + 1
If num > 0 Then
If dif > Val(num) Then
m = n + Val(num) - 1
End If
End If
If k + dif > 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
Hola Dante,
Fantástico!
Solo me gustaría que el valor que introduzcamos sea el máximo del rango que estamos "spliteando".
Pero para esto te abro otra pregunta, esta respuesta la doy por excelente.
Muchas gracias!
Saludos,
Roberto
