Excel - Ayuda con un macro que funcione según celdas seleccionadas

 
Vista:

Ayuda con un macro que funcione según celdas seleccionadas

Publicado por Francisco gonzalez (1 intervención) el 19/06/2018 23:22:15
Quiero realizar una macro en la que estoy selecionando ciertas celdas (A2, A1500, A3000, ETC) y se le agregue un valor, le cambie el color de la fuente y por ultimo borre el valor de la celda de abajo, esto ya lo logre solo que no se como debo seguir escribiendo las instrucciones y haga lo mismo que en el primer bloque es decir:


Range("A2") = "clr"

Range("A2").Font.ColorIndex = 1

ActiveCell.Offset(1, 0).Select

ActiveCell.ClearContents

End Sub

Como continuo con el siguiente bloque, la siguiente celda que debe ser ("A1500") despues ("A3000"), etc.

Agradezco como siempre su respeusta oportuna, Masters.

Gracias.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 3.899
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Ayuda con un macro que funcione según celdas seleccionadas

Publicado por Antoni Masana (1334 intervenciones) el 20/06/2018 11:50:44
Con estos tres valores es difícil deducir la secuencia pero podría ser 4500, 6000. 7500, 9000, etc

Se puede hacer de varias formas, aquí una de ellas:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Macro()
    Dim Fila As Long
    Fila = 2
    While Range("A" & Fila) <> ""
        Range("A" & (Fila + 0)).Font.ColorIndex = 1
        Range("A" & (Fila + 1)).Select
        ActiveCell.ClearContents
        If Fila = 2 Then Fila = 0
        Fila = Fila + 1500
    Wend
    MsgBox "Fin"
End Sub


Si la hoja esta llena daria un error y esta opción lo evita

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro()
    Dim Fila As Long
    Fila = 2
    While Fila < 2 ^ 20
        If Range("A" & (Fila + 0)) <> "" Then
           Range("A" & (Fila + 0)).Font.ColorIndex = 1
           Range("A" & (Fila + 1)).Select
           ActiveCell.ClearContents
           If Fila = 2 Then Fila = 0
           Fila = Fila + 1500
        End If
    Wend
    MsgBox "Fin"
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar