¿Cómo añadir celdas según valor?
Mi actual tabla es de la siguiente forma:
http://www.ayudaexcel.com/foro/attachments/dibujo1-jpg.54369/
Mi actual macro hace que quede de la siguiente forma:
http://www.ayudaexcel.com/foro/attachments/dibujo2-jpg.54370/
Mi consulta es la siguiente:
¿como puedo modificar el código que tengo cuando me aparece de la siguiente manera?
http://www.ayudaexcel.com/foro/attachments/dibujo3-jpg.54372/
Cuando tengo datos en la misma fila debo colocarlo de manera escalonada.
Y que me quede algo así:
http://www.ayudaexcel.com/foro/attachments/dibujo4-jpg.54374/
El codigo de la macro es el siguiente:
Sub CopyCodes() Dim F1, F2, C1&, C2&, I& With Range("g3", Range("G" & Rows.Count).End(xlUp)) F1 = Evaluate("if(isnumber(" & .Address & ")*isodd(countif(offset(" & .Cells(1).Address & ",,," & _ "row(" & .Address & ")-min(row(" & .Address & "))+1),"">0"")), row(" & .Address & ")-min(row(" & .Address & ")))") F2 = Evaluate("if(isnumber(" & .Address & ")*iseven(countif(offset(" & .Cells(1).Address & ",,," & _ "row(" & .Address & ")-min(row(" & .Address & "))+1),"">0"")), row(" & .Address & ")-min(row(" & .Address & ")))") C1 = Application.Count(F1): C2 = Application.Count(F2) For I = 1 To C1 With Range("g3").Offset(Application.Small(F1, I)) .Resize(.Offset(, -1)) = Range("g2") End With Next I For I = 1 To C2 With Range("h3").Offset(Application.Small(F2, I)) .Resize(.Offset(, -2)) = Range("h2") End With Next I End With Erase F1, F2End Sub
1 Respuesta
No se ven las imágenes, puedes poner otras o envíame tu archivo con la macro y con los datos, en cada hoja me pones los datos, de lo que tienes, cómo te queda y cómo quieres que te quede.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Andres Reyes” y el título de esta pregunta.
Te envíe el correo, saludos. Quedo en espera de tu pronta respuesta.
Prueba con esta macro:
Sub celdas()
'Por.Dante Amor
For i = 3 To Range("F" & Rows.Count).End(xlUp).Row
n = i
If Cells(i, "F") > 0 And Cells(i, "G") > 0 Then
For j = 1 To Cells(i, "G")
Cells(n, "G") = j
n = n + 1
Next
End If
n = i
If Cells(i, "F") > 0 And Cells(i, "H") > 0 Then
For j = 1 To Cells(i, "H")
Cells(n, "H") = j
n = n + 1
Next
End If
Next
MsgBox "terminado"
End SubSaludos.Dante Amor
Si es lo que necesitas.
Probando tu macro, por ahí va el asunto, conteste a tu correo.
Saludos y gracias.
Te anexo la macro para verificar la cantidad y lo asignado. Y para poner los textos.
Sub celdas()
'Por.Dante Amor
For i = 3 To Range("F" & Rows.Count).End(xlUp).Row
n = i
ini = Columns("G").Column
fin = Columns("I").Column
If Cells(i, "F") > 0 Then
wsum = Application.Sum(Range(Cells(i, ini), Cells(i, fin)))
If Cells(i, "F") <> wsum Then
Cells(i, "F").Interior.ColorIndex = 6
MsgBox "La Cantidad no es igual a lo asignado"
Else
For k = ini To fin
If Cells(i, k) > 0 Then
num = Cells(i, k)
Cells(i, k) = ""
For j = 1 To num
Cells(n, k) = Cells(2, k)
n = n + 1
Next
End If
Next
End If
End If
Next
MsgBox "terminado"
End SubVamos a ocupar tu macro para insertar filas, lo único que falta es llamar a la macro "celdas", después de la instrucción Loop:
Sub InsertarFilasCantidadCodigo() Dim filas As Integer Dim var As Integer filas = 3 Do Until Cells(filas, 6) = "" If Cells(filas, 6) <> 0 Or Cells(filas, 6) <> "" Or Val(Cells(filas, 6)) > 0 Then var = Cells(filas, 6) - 1 For m = 1 To var Rows(filas + 1).Select Selection.Insert Next m End If filas = filas + var + 1 Loop celdas End Sub
Saludos.Dante Amor
Recuerda cambiar la valoración de la respuesta.
Dante, eres una gran persona, me ayudaste con mi rompecabezas.
¡De verdad Mil Gracias!
Recuerda cambiar la valoración de la respuesta!
