Cómo hacer que la macro busque hacia la derecha hasta que encuentre una celda vacía
La siguiente macro nos permite dividir un rango e.g. 0002-0015 en sus valores únicos copiando éstos, junto con los datos asociados (presentes en la columna "A"), en una Hoja2. También nos permite ingresar un valor máximo de los resultados a mostrar.
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 SubActualmente la macro busca los rangos a dividir en la columna "B" de la Hoja1 pero me gustaría saber qué código debo introducir y dónde para que busque también en las siguientes columnas (hacia la derecha) hasta que encuentre una celda vacía.
Nota: el número de celdas con rangos varía según la línea pero siempre empiezan en la columna "B".
2 Respuestas
Hola Dante,
No me expliqué bien, la forma en que se disponen los datos en la tabla es:
A B C D E
Dato Rango Rango Rango
Dato Rango
Dato Rango Rango Rango Rango
.
.
.
Es decir, todos los rangos de la columna "B" en adelante corresponden al dato de la columna "A".
Muchas gracias!
Saludos y buen día,
Roberto
Del ejemplo que pusiste, puedes poner cómo esperas el resultado, no me queda claro cómo se va a colocar el resultado del tercer DATO columna B, si el segundo DATO en la columna B no tiene rango.
Por ejemplo:
Si el primer dato, según tu ejemplo, tiene 3 rangos. Sería así:
Hoja Origen
A B C D
1 Dato1 1-2 2-3 3-4
2 Dato2 3-5
Hoja Resultado
A B C D
1 Dato1 1
2 Dato1 2
3 Dato1 2
4 Dato1 3
5 Dato1 3
6 Dato1 4
7 Dato2 3
8 Dato2 4
9 Dato2 5
Esa es la forma que yo encuentro de que los rangos de los primeros datos no se mezclen con los rangos de otros Datos, es decir, la secuencia siempre sería hacia abajo.
Hola,
Todos los resultados (de la división de rangos) deberían ir en la columna B. En principio, los rangos de una misma fila nunca se van a solapar (es decir, no se mezclarían). Y en caso de solaparse no me importa que haya registros duplicados; la idea es sacar solo dos columnas una con el dato de la columna A (repetido tantas veces como sea necesario para cubrir todos los valores contenidos en los rangos de las columnas B y siguientes).
Siguiendo tu ejemplo, quedaría:
Hoja Resultado
A B C D
1 Dato1 1
2 Dato1 2
3 Dato1 2
4 Dato1 3
5 Dato1 3
6 Dato1 4
7 Dato2 3
8 Dato2 4
9 Dato2 5
Pero como ya te digo, no es probable que los rangos se solapen por lo que no se repetirían registros. Y en caso de suceder, me bastaría con quitar los duplicados.
Muchas gracias por todo!
Saludos,
Roberto
Te anexo la macro para poner los resultados en las columnas A y B
Sub DividirValorColumna()
'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)
k = 1
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
For c = 2 To h1.Cells(i, Columns.Count).End(xlToLeft).Column
If h1.Cells(i, c) <> "" Then
dato = h1.Cells(i, "A")
valor = Split(h1.Cells(i, c), "-")
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, "A") = dato
h2.Cells(k, "B") = j
k = k + 1
Next
End If
Next
Next
Application.ScreenUpdating = True
h2.Select
MsgBox "División de valores terminada", vbInformation
End SubSaludos.Dante Amor
