Repetir el valor de varias celdas en función del valor de otras
Tengo una base de datos con información en la columna A, la cual quiero que se repita de acuerdo a lo que indica la columna B.
Espero me puedan ayudar.
A la vez cabe indicar que la columna A y B es referencial, dado que es un modelo de lo que busco.
3 Respuestas
La respuesta ya ha sido valorada, pero me gustaría agregar información para ambos y para otras personas que puedan leer esto.
Lo que quiero puntualizar es que si bien la sugerencia de Isaac funciona perfectamente a simple vista, el rendimiento podría mejorarse mucho.
Lo primero es que si conoces el numero exacto de filas con las que vas a trabajar, no debes usar un bucle Do While, en su lugar deberías usar For... Next, en este caso For Each. Yo suelo evitar el Do While a menos que el bucle recorra demasiados rangos variables, pero en este caso, solo hay que recorrer una columna, la cual tendrá una fila final, y ese es el número exacto de veces que se va a ejecutar el bucle. Almacenando este valor en una variable, le indicas al bucle exactamente cuando va a terminar, sin necesidad de hacer una comprobación cada vez.
Lo segundo es que, si vas a recorrer menos 32767 filas (treinta y dos mil!) no tienes que usar una variable de tipo Long. ¿Para qué almacenar 4 bytes si puedes almacenar 2 bytes? De todas formas, hacer un bucle en excel en tantas filas, es una locura. La mejor estrategia siempre será usar la función "Evaluate"... la más poderosa función en Excel VBA, pero ya eso es otro tema.
En conclusión, así es como yo lo haría:
Sub Repeticiones()
Application.ScreenUpdating = False
'Si algun dia tienes la necesidad de un bucle de mas de 32 mil repeticiones,
'probablemente sea una mala idea, y deberias considerar usar EVALUATE
'asi que... integer en lugar de long
Dim DatosCol As Integer
Dim RepsCol As Integer
Dim Reps As Integer
Dim i As Integer
Dim rCell As Range
Dim rRng As Range
'Aqui es donde se determina el número exacto de ejecuciones
DatosCol = Range("A" & Rows.Count).End(xlUp).Row
Set rRng = Range("A2:A" & DatosCol)
For Each rCell In rRng.Cells
Reps = Range("B" & rCell.Row).Value
For i = 0 To Reps
RepsCol = Range("E" & Rows.Count).End(xlUp).Row + 1
Range("E" & RepsCol).Value = rCell.Value
Next i
Next rCell
Application.ScreenUpdating = True
End Sub
Buenas tardes Andy:
E realizado la nueva función pero me indica error en la siguiente proceso: Reps = Range("DK" & rCell.Row).Value, me indica error "no coincide lo tipos".
Por favor pido tu apoyo.
Saludos
Ahora leyendo tu pregunta y mirando mi código veo que cometí un error en el for interno donde dice For i = 0 to Reps
Deberia decir For i = 1 to Reps.
Tiene que decir 1, no 0
Ahora bien, eso no tiene nada que ver con tu pregunta, solo estoy rectificando una equivocación mía.
En cuanto al error no sabría decirte. ¿Puedes mostrarme como te quedo el código? Yo uso Excel y todos los programas en Ingles, y me pierdo un poco cuando me mencionan errores en español. Así que no estoy seguro de que sea, pero me parece que al ajustar el código moviste algo que ha afectado la referencia a alguna fila. Ese error me suena a que no encuentra una referencia a alguna fila.
Había un problemita en una línea que Isaac descubrió, al final use una parte de su código y ahora si queda optimizado así:
Dim lstCol As Integer
Dim Reps As Integer
Dim rCell As Range
Dim rRng As Range
DatosCol = Range("DJ" & Rows.Count).End(xlUp).Row
lstCol = 8
Set rRng = Range("DJ8:DJ" & DatosCol)
For Each rCell In rRng.Cells
Reps = Range("DK" & rCell.Row).Value
Cells(lstCol, 117).Resize(Reps, 1).Value = Range("DJ" & rCell.Row).Value
lstCol = lstCol + Reps
Next rCell
End Suboooh boy! me has dado trabajo con esas columnas tan atrás lol
Según entiendo ahora los datos comienzan en DJ8 y las repeticiones están en DK (asumo que comienzan en la misma fila 8).
Ahora se escribirán los datos en DM (columna 117) comenzaran a escribirse también en la columna 8. Eso ultimo lo puedes cambiar modificando la variable lstCol, cambiando el 8 por el numero que quieras. La columna también la puedes cambiar modificando el 117.
Disculpa, me comí una parte al comienzo y todoexpertos no permite editar, ahora si:
Sub Repeticiones()
Dim DatosCol As Integer
Dim lstCol As Integer
Dim Reps As Integer
Dim rCell As Range
Dim rRng As Range
DatosCol = Range("DJ" & Rows.Count).End(xlUp).Row
lstCol = 8
Set rRng = Range("DJ8:DJ" & DatosCol)
For Each rCell In rRng.Cells
Reps = Range("DK" & rCell.Row).Value
Cells(lstCol, 117).Resize(Reps, 1).Value = Range("DJ" & rCell.Row).Value
lstCol = lstCol + Reps
Next rCell
End Sub
Hola Andy:
Al ejecutar la macro me sale este error, no se si es por algún motivo que genera este error.
Haber si puedes ayudarme en dar solución.
Saludos.
Oh, ese error suele ocurrir cuando le asignas a una variable un valor de otro tipo. ¿Qué línea te marca en amarillo si le das en Depurar?
Hola Andy:
Al depurar me indica en la siguiente línea:
Reps = Range("DK" & rCell.Row).Value
Espero me puedas ayudar en la solución.
Saludos,
Te soy sincero, no tengo idea de que esta mal. ¿El código de Isaac también te da problemas? De la única forma que podre ayudarte es si me pasas el archivo excel y yo abrirlo y mirarlo con mis propios ojos, si quieres puedes mandar solamente esa hoja.
Mega me pide una clave para acceder al archivo
Hola Andy:
Perdón creo que copia el enlace incorrecto.
Te adjunto nuevo enlace.
https://mega.nz/#!a2ZwzCCL!gGCQMeFYmk-PuJjuHKsCDiaGn1VjKWDp6jjOULKES2Y
Saludos.
Rudy, creo que he encontrado el problema. La columna DJ aparentemente tenia caracteres invisibles que estaban confundiendo a la linea: DatosCol = Range("DJ" & Rows. Count).End(xlUp). Row
Esa linea se encarga de encontrar la ultima celda con datos, al haber caracteres invisibles, el código tomaba la celda incorrecta, por ende, la linea: Reps = Range("DK" & rCell.Row).Value buscaba un Integer vacío, y ocasionaba un error de type mistmatch ya que un espacio vacío no puede ser un integer.
Para solucionarlo, es muy fácil, solo debes limpiar algunas de las celdas en la columna DJ seleccionándolas, click derecho y click en "Limpiar contenido" (yo lo tengo en ingles, no sé como dice en español exactamente) así:
A parte de eso mejore un poco el código sustituyendo un pedacito, quedaría asi:
Sub Repeticiones()
Dim DatosCol As Integer
Dim startRow As Integer
Dim Reps As Integer
Dim rCell As Range
Dim rRng As Range
DatosCol = Range("DJ" & Rows.Count).End(xlUp).Row
startRow = 8
Set rRng = Range("DJ8:DJ" & DatosCol)
For Each rCell In rRng.Cells
Reps = rCell.Offset(0, 1).Value
Cells(startRow, 117).Resize(Reps, 1).Value = rCell.Value
startRow = startRow + Reps
Next rCell
End SubEl problema no era el código, sino algo en tus celdas, algún carácter invisible se había colado y no te diste cuenta..
Si continuas teniendo problemas, déjame saber.
Salud2s
Este es los nuevos cambios que hice para duplicar información:
Sub Repeticiones()
Application.ScreenUpdating = False
'Si algun dia tienes la necesidad de un bucle de mas de 32 mil repeticiones,
'probablemente sea una mala idea, y deberias considerar usar EVALUATE
'asi que... integer en lugar de long
Dim DatosCol As Integer
Dim RepsCol As Integer
Dim Reps As Integer
Dim i As Integer
Dim rCell As Range
Dim rRng As Range
'Aqui es donde se determina el número exacto de ejecuciones
DatosCol = Range("DJ" & Rows.Count).End(xlUp).Row
Set rRng = Range("DJ8:DJ" & DatosCol)
For Each rCell In rRng.Cells
Reps = Range("DK" & rCell.Row).Value
For i = 1 To Reps
RepsCol = Range("DM" & Rows.Count).End(xlUp).Row + 1
Range("DM" & RepsCol).Value = rCell.Value
Next i
Next rCell
Application.ScreenUpdating = True
End Sub
Pero al ejecutar me dice que no coincide los tipos, y el error me selecciona aqui:
Reps = Range("DK" & rCell.Row).Value
H0la Rudy:
Esta macro debiera funcionar para la estructura que muestras en el ejemplo.
Sub num() 'Por GP' Dim fila As Long Dim filaIni As Long fila = 2 'Fila en que inicia el ciclo' filaIni = fila 'Fila en que se comienzan a replicar los datos' 'Repetir hasta no encontrar datos en columna A' Do Until Cells(fila, 1).Value = "" 'Agregar los datos en columna D' Cells(filaIni, 4).Resize(Cells(fila, 2).Value, 1).Value = Cells(fila, 1).Value 'Generar incrementos' filaIni = filaIni + Cells(fila, 2).Value fila = fila + 1 Loop End Sub
S@lu2
Buenos días Isaac:
Agradezco tu apoyo en la solución quedo estupendo.
En relación a la consulta como hago para modificar la columna A y B ahora quiero que sea otra no se un AB y AD.
Saludos.
En la siguiente línea
Cells(fila, 1)
El 1 representa a la columna A, un 2 representaría a la B, un 3 a la C y así sucesivamente. De tal forma, que la columna AB sería la 28 y la AD sería la 30.
Andy, me mataste con el EVALUATE, no lo conozco, lo voy a estudiar ¡gracias!El For Each, lo pensé, tienes razón el el número de comparaciones, lo consideraré en otras respuestas.Pero con respecto al for interno, humildemente, sigo viendo más eficiente mi código. Creo que una combinación de ambos quedaría genial, a no ser que tengas otra carta bajo la manga.Un gusto leer tu respuesta. - Isaac Reyes
Hola Isaac. Evaluate es muy poderoso, no está de más echarle un vistazo. El For interno no afecta en nada pero igual se puede quitar, e incluso se puede meter parte de tu código y sustituir el For interno con esta línea y ya ahí tienes una combinación de amos ja ja:Range("E" & RepsCol).Resize(Range("B" & rCell.Row).Value, 1).Value = Cells(rCell.Row, 1).ValueUsando la propiedad resize. Yo personalmente no lo prefiero así, ya que estéticamente no me gusta tener tanto código en una sola línea, más para alguien que esta aprendiendo se le puede hacer tedioso de leer y comprender, pero funciona igual :) - Andy Machin
Sinceramente, tampoco me gusta complicar mucho las líneas de código, pero hay tantas cosas que uno va aprendiendo acá mismo, que caigo en la tentación de ocuparlo. Pero se aprecia la observación. En cuanto al For interno, yo díría que sí afecta y bastante más que el do externo. De puro curioso, eché a correr nuestras dos macros utilizando 300 datos con 5 repeticiones cada uno y sí que hay diferencias.Mirando tu macro con más detención, creo que la línea que le quita eficiencia es esta RepsCol = Range("E" & Rows.Count).End(xlUp).Row + 1 - Isaac Reyes
Isaac Reyes me había olvidado responder tu ultimo comentario. En que te basas para decir que tiene poca eficiencia? Si lo dices por un pequeño pestañeo que hace la pantalla, eso se produce por el Application.ScreenUpdating. Si se lo quitas deja de brincar la pantalla, pero no es una buena practica actualizar tantos datos en la hoja sin apagar antes el ScreenUpdating. Yo lo pongo ya por inercia, se lo agregue a mi código por la costumbre.. Salu2 - Andy Machin
No lo digo por el pestañeo, sino por una diferencia notoria en el tiempo de ejecución. Con los 300 datos y 5 repeticiones por datos el mío demora 0,02seg. aprox. y el tuyo demora varios segundos.En cuanto a ScreenUpdating, todo depende, pero sí es una buena práctica utilizarlo, aunque en este caso particular, no es mucha la influencia que tiene. ;-) - Isaac Reyes
Vaya, pues yo probé 499 números, osea hasta la fila 500 teniendo en cuenta el encabezado, luego en las repeticiones puse mínimo 3 y máximo 30 en un patrón constante (son muchas repeticiones!) en total se escribieron valores hasta la fila 8117. Y a mi no me dio diferencia en tiempo, ambos códigos se ejecutan igual de rápido en mili segundos. hmmmm - Andy Machin
Tienes razón, hay una pequeña diferencia, pero no es tan notable en mi PC. Y también tienes razón al indicar la línea, es esa misma línea la que causa el retraso.. gracias :) - Andy Machin