Macro que funcione con 90 rangos
Acudo a ustedes en busca de Ayuda.
Necesito que esta macro funcione en 90 rangos discontinuos.
La idea es que al dar clic en las celdas de los rangos, si está vacío se escriba "R", per si tiene "R" esa celda, entonces se quede vacío ("").
Me ha funcionado hasta el momento, pero solo con 25 rangos y necesito que funcione con 90 rangos discontinuos.
¿Cómo puedo arreglar ese problema?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ManejoError
If Not Intersect(Target, Range("U5:AA14, AC5:AI14, BA5:BG14, BI5:BO14, AS5:AY14, AK5:AQ14, U16:AA26, AC17:AI26, AK17:AQ26, AS17:AY26, BA17:BG26, BI17:BO26, U17:AA26, AC17:AI26, AK17:AQ26, AS17:AY26, BA17:BG26, BI17:BO26, U29:AA38, AC29:AI38, AK29:AQ38, AS29:AY38, BA29:BG38, BI29:BO38")) Is Nothing Then
If Target.Value = "R" Then
Target.Value = ""
ElseIf Target.Value = "" Then
Target.Value = "R"
End If
Rem ActiveCell.EntireColumn.Cells(4).Select
End If
Exit Sub
ManejoError:
End Sub
1 Respuesta
Visita:
Cursos de Excel y Macros
----- --
Es más simple si solamente limitas en cuáles columnas y en cuáles filas quieres el funcionamiento.
Ajusta las columnas y las filas en esta parte de la macro:
Set rng = Intersect(Target, Range("U:BO"), Rows("5:182")).
----- --
Según tus rangos, pude determinar en cuáles celdas quieres el funcionamiento.
Con el siguiente código, te permite seleccionar una celda o varias celdas, si las celdas seleccionadas están dentro de los límites del funcionamiento, entonces los valores van a cambiar de "" a "R" y de "R" a "".
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim valor As String
Dim rng As Range, c As Range
'
Set rng = Intersect(Target, Range("U:BO"), Rows("5:182"))
If Not rng Is Nothing Then
For Each c In rng
If c.Column Mod 8 <> 4 And c.Row Mod 12 <> 3 And c.Row Mod 12 <> 4 Then
If c.Value = "R" Then valor = ""
If c.Value = "" Then valor = "R"
c.Value = valor
End If
Next
End If
End Sub----- --
