Realizar macro que busque una condición y si la encuentra muestre el mensaje y si no ejecute otra macro
Buenos días
Me llamo Antonio y no se de VBA, pero buscando y con lo poco que se he conseguido elaborar estos dos códigos, que hacen lo que indico adelante
Un código que me dice las celdas que hay combinadas en una hoja, mediante un msgbox, el problema es que cuando no hay celdas combinadas el mensaje te sale en blanco
Si le añado el else para que haga una u otra cosa el código no funciona con las celdas combinadas
Necesito
Una macro que:
Si hay celdas combinadas me las indique y se pare el proceso y si no hay celdas combinadas active una macro que ya tengo y que ordena la hoja
He encontrado un código al que yo he intentado sin éxito añadir la segunda condición
Te adjunto códigos ( este primero funciona pero muestra mensaje en blanco sin celdas combinadas, necesito que en ese caso no muestre mensaje y ejecute una macro)
Sub IdentificaCeldasCombinadas1()
'inhabilitamos el refresco de pantalla
Application.ScreenUpdating = False
'controlamos un posible error, pasando al siguiente registro
On Error Resume Next
'recorremos cada celda del rango utilizado en la hoja de cálculo activa.
For Each celda In ActiveSheet.UsedRange
'verificamoss si dicha celda corresponde a una Celda combinada
If celda.MergeCells = True Then
'aglutinamos la dirección de la celda
'para mostrala posteriormente en un MsgBox
mensaje = mensaje & celda.Address & Chr(10)
End If
Next
'Mostramos el mensaje final,
'con todas las referencias de las celdas combinadas (individualmente)
MsgBox mensaje
'activamos el refresco de pantalla
Application.ScreenUpdating = True
End Sub
Este otro código con el else ( este código ignora la primera parte y ejecuta la acción después del else, pero no muestra las celdas combinadas)
Sub IdentificaCeldasCombinadas2()
'inhabilitamos el refresco de pantalla
Application.ScreenUpdating = False
'controlamos un posible error, pasando al siguiente registro
On Error Resume Next
'recorremos cada celda del rango utilizado en la hoja de cálculo activa.
For Each celda In ActiveSheet.UsedRange
'verificamoss si dicha celda corresponde a una Celda combinada
If celda.MergeCells = True Then
'aglutinamos la dirección de la celda
'para mostrala posteriormente en un MsgBox
mensaje = mensaje & celda.Address & Chr(10)
'Mostramos el mensaje final,
'con todas las referencias de las celdas combinadas (individualmente)
MsgBox mensaje
Application.ScreenUpdating = True
''paramos el proceso
End
'en el caso de no existir celdas combinadas
Else
'Mostramos el mensaje final,
MsgBox "sin combinadas"
'ejecutamos la macro
ordenar
''paramos el proceso para que no se repita
End
End If
Next
'activamos el refresco de pantalla
Application.ScreenUpdating = True
End Sub
Un saludo y muchas gracias
1 Respuesta
Creo que el código que necesitas es este:
Sub IdentificaCeldasCombinadas1()
mensaje=""
'inhabilitamos el refresco de pantalla
Application.ScreenUpdating = False
'controlamos un posible error, pasando al siguiente registro
On Error Resume Next
'recorremos cada celda del rango utilizado en la hoja de cálculo activa.
For Each celda In ActiveSheet.UsedRange
'verificamoss si dicha celda corresponde a una Celda combinada
If celda.MergeCells = True Then
'aglutinamos la dirección de la celda
'para mostrala posteriormente en un MsgBox
mensaje = mensaje & celda.Address & Chr(10)
End If
Next
If len(mensaje)=0 Then 'Si esta linea te da error, prueba con If mensaje="" Then
'Mostramos el mensaje final,
'con todas las referencias de las celdas combinadas (individualmente)
MsgBox mensaje
Else
'Mostramos el mensaje final,
MsgBox "sin combinadas"
'ejecutamos la macro
ordenar
End
'activamos el refresco de pantalla
Application.ScreenUpdating = True
End Sub
Muchas gracias, daba un error porque faltaba un end if
le he cambiado el texto del mensaje
mensaje = mensaje & celda.Address & Chr(10) por
mensaje = mensaje & celda.MergeArea.Address & Chr(10), para que muestre el rango
pero se repite el rango en el mensaje tantas veces como celdas hay implicadas
necesitaria que en el mensaje saliese un encabezado aclaratorio por ejemplo
Modifica las siguientes celdas combinadas y a continuacio los rangos sin que se repitan
muchas gracias
A ver qué tal así:
Sub IdentificaCeldasCombinadas1()
mensaje=""
'inhabilitamos el refresco de pantalla
Application.ScreenUpdating = False
'controlamos un posible error, pasando al siguiente registro
On Error Resume Next
'recorremos cada celda del rango utilizado en la hoja de cálculo activa.
For Each celda In ActiveSheet.UsedRange
'verificamoss si dicha celda corresponde a una Celda combinada
If celda.MergeCells = True Then
'aglutinamos la dirección de la celda
'para mostrala posteriormente en un MsgBox
mensaje = celda.MergeArea.Address & Chr(10)
End If
Next
If len(mensaje)=0 Then 'Si esta linea te da error, prueba con If mensaje="" Then
'Mostramos el mensaje final,
'con todas las referencias de las celdas combinadas (individualmente)
mensaje="Modifica las siguientes celdas combinadas: " & mensaje
MsgBox mensaje
Else
'Mostramos el mensaje final,
MsgBox "sin combinadas"
'ejecutamos la macro
ordenar
End If
'activamos el refresco de pantalla
Application.ScreenUpdating = True
End Sub
Buenos días y muchas gracias
No me funciona bien porque si hay más de un rango de celdas combinadas solo muestra un rango, el resto los omite
Te adjunto el código que tengo al día de hoy para que puedas ver el funcionamiento, tanto con celdas combinadas como sin ellas
Sub IdentificaCeldasCombinadasexp2()
mensaje = ""
'inhabilitamos el refresco de pantalla
Application.ScreenUpdating = False
'controlamos un posible error, pasando al siguiente registro
On Error Resume Next
'recorremos cada celda del rango utilizado en la hoja de cálculo activa.
For Each celda In ActiveSheet.UsedRange
'verificamoss si dicha celda corresponde a una Celda combinada
If celda.MergeCells = True Then
'aglutinamos la dirección de la celda para mostrala posteriormente en un MsgBox
'CELDAS SUELTAS
'mensaje = mensaje & celda.Address & Chr(10) 'muestra la celda
'RANGOS
mensaje = mensaje & celda.MergeArea.Address & Chr(10) ' muestra el rango pero se repite
'mensaje = celda.MergeArea.Address & Chr(10) ' no muestra todos los rangos
With celda ' de momento solo me interesa la opcion del color
''eliminando cualquier Comentario anterior
' .ClearComments
''Añadimos uno nuevo...
' .AddComment
' '... Donde insertamos un texto con la dirección del Rango combinado
'.Comment.Text Text:="Excelforo:" & Chr(10) & celda.MergeArea.Address
''además le cambiamos el color de fondo a amarillo.
.Interior.ColorIndex = 15
End With
End If
Next
If Len(mensaje) = 0 Then 'Si esta linea te da error, prueba con If mensaje="" Then
'Mostramos el mensaje final,
MsgBox "sin combinadas", vbInformation, "CELDAS COMBINADAS"
'ejecutamos la macro
Ordenar
Else
''Mostramos el mensaje final,
'con todas las referencias de las celdas combinadas
mensaje = "Modifica las siguientes celdas combinadas: " & Chr(13) & "" & Chr(13) & mensaje & Chr(13) & "" & Chr(13) & " Se pone el fondo en gris facilitar la busqueda"
MsgBox mensaje, vbInformation, "CELDAS COMBINADAS"
End
End If
'activamos el refresco de pantalla
Application.ScreenUpdating = True
'End If
End Sub
Muchas gracias
Pues no sé que decirte, a mí sí me funciona si hay varias celdas combinadas, aunque me repite los rangos tantas veces como celdas hay en cada combinación.
Para solucionar este problemilla, puedes probar usando colecciones de objetos, tal que así:
Sub IdentificaCeldasCombinadasexp2()
'Declaras las variables
Dim celdasComb As Collection
Set celdasComb = New Collection
'inhabilitamos el refresco de pantalla
Application.ScreenUpdating = False
'controlamos un posible error, pasando al siguiente registro
On Error Resume Next
'recorremos cada celda del rango utilizado en la hoja de cálculo activa.
For Each celda In ActiveSheet.UsedRange
'verificamos si dicha celda corresponde a una Celda combinada
If celda.MergeCells = True Then
CeldasComb. Add celda. MergeArea. Address 'Añades todos los rangos a la colección (los habrá repetidos)
With celda ' de momento solo me interesa la opcion del color
''eliminando cualquier Comentario anterior
' .ClearComments
''Añadimos uno nuevo...
' .AddComment
' '... Donde insertamos un texto con la dirección del Rango combinado
'.Comment.Text Text:="Excelforo:" & Chr(10) & celda.MergeArea.Address
''además le cambiamos el color de fondo a amarillo.
.Interior.ColorIndex = 15
End With
End If
Next
If celdasComb.Count = 0 Then 'Si la coleccion no tiene elementos=> no hay combinadas
mensaje = ""
Else
mensaje = celdasComb.Item(1) & Chr(10)
For i = 2 To celdasComb.Count
If celdasComb.Item(i) = celdasComb.Item(i - 1) Then
'Si el rango es igual al anterior, no haces nada
Else
'Creas la parte variable del mensaje
mensaje = mensaje & celdasComb.Item(i) & Chr(10)
End If
Next
End If
If Len(mensaje) = 0 Then 'Si esta linea te da error, prueba con If mensaje="" Then
'Mostramos el mensaje final,
MsgBox "sin combinadas", vbInformation, "CELDAS COMBINADAS"
'ejecutamos la macro
Ordenar
Else
'Mostramos el mensaje final,
'con todas las referencias de las celdas combinadas
mensaje = "Modifica las siguientes celdas combinadas: " & Chr(13) & "" & Chr(13) & mensaje & Chr(13) & "" & Chr(13) & " Se pone el fondo en gris facilitar la busqueda"
MsgBox mensaje, vbInformation, "CELDAS COMBINADAS"
End If
'activamos el refresco de pantalla
Application.ScreenUpdating = True
End Sub
