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

Respuesta
1

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas