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
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.
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
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