UDF para comprobar sumas en un rango de celdas

[Antoni]

Hola:

Se explica por si solo.

Function COMPROBAR(Rango As Range) As String

'--------------------------------------------------------

'Esta UDF, comprueba que los valores de las celdas de

'la última fila y última columna del rango, coincidan con

'el sumatorio de los valores de las celdas de sus respectivas

'filas y columnas del rango, en caso de diferencias, se añade

'un comentario con el valor calculado

'Ejemplo:

'

' Rango A3:D5, se comprueba que,

'

'   A3+B3+C3=D3

'   A4+B4+C4=D4

'   A5+B6+C5=D5

'   A3+A4=A5

'   B3+B4=B5

'   C3+C4=C5

'   D3+D4=D5

'

'--------------------------------------------------------

Dim MAXROW As Double

Dim MAXCOLUMN As Double

Dim MINROW As Double

Dim MINCOLUMN As Double

Dim TOTAL As Double

Dim x As Double, y As Double

'--------------------------------------------------------

'Inicializamos variables

COMPROBAR = ""

MAXROW = 0: MAXCOLUM = 0

MINROW = 999999: MINCOLUMN = 999999


'--------------------------------------------------------

'Buscamos fila y columna de 1ª y última celda del rango

On Error Resume Next

For Each CELDA In Rango

   CELDA.ClearComments

   If CELDA.Row > MAXROW Then MAXROW = CELDA.Row

   If CELDA.Column > MAXCOLUMN Then MAXCOLUMN = CELDA.Column

   If CELDA.Row < MINROW Then MINROW = CELDA.Row

   If CELDA.Column < MINCOLUMN Then MINCOLUMN = CELDA.Column

Next


'--------------------------------------------------------

'Si no hay rango, nos vamos

If MAXROW = MINROW And MAXCOLUMN = MINCOLUMN Then Exit Function


'--------------------------------------------------------

'Cuadramos filas

For x = MINROW To MAXROW

   TOTAL = 0

   For y = MINCOLUMN To MAXCOLUMN - 1

      TOTAL = TOTAL + ActiveSheet.Cells(x, y)

   Next y

   If TOTAL <> ActiveSheet.Cells(x, MAXCOLUMN) Then

      Beep

      With ActiveSheet.Cells(x, MAXCOLUMN)

          .AddComment

          .Comment.Text Text:="Sumado: " & FormatNumber(TOTAL)

          .Comment.Shape.Height = 20

          .Comment.Shape.Width = Len(FormatNumber(TOTAL)) * 12 + 20

      End With

   End If

Next x


'--------------------------------------------------------

'Cuadramos columnas

For y = MINCOLUMN To MAXCOLUMN

   TOTAL = 0

   For x = MINROW To MAXROW - 1

      TOTAL = TOTAL + ActiveSheet.Cells(x, y)

   Next x

   If TOTAL <> ActiveSheet.Cells(MAXROW, y) Then

      Beep

      With ActiveSheet.Cells(MAXROW, y)

          .AddComment

          .Comment.Text Text:="Sumado: " & FormatNumber(TOTAL)

          .Comment.Shape.Height = 20 'Alto

          .Comment.Shape.Width = Len(FormatNumber(TOTAL)) * 12 + 20

      End With

   End If

Next y


End Function

[/CODE]

Probarla a ver que os parece. Quizás ya exista, si es así, se ruega eliminar el post.

Saludos. Antoni.

[Gerson Pineda]

Antoni

Sera posible que adjuntes porfavor un archivo y ejemplo para ver si lo entendemos

Saludos

[Antoni]

Hola:

Ahí va el enlace:

COMPROBAR.xls

Un saludo. Antoni.

[Gerson Pineda]

Antoni

No sera que puede estar pasando, pero al probar tu UDF me deja enciclado el Excel, es decir busco la funcion, y luego al querere marcar algun rango queda corriendo la rutina, disculpame si esto confunde a los demas, pero no me funciona

Saludos

[Antoni]

Hola Gerson:

No consigo reproducir la situación que me expones, para mayor seguridad me he bajado el archivo que envíe, pero me funciona correctamente.

Si puedes envía una imagen del problema.

Saludos. Antoni

[Gerson Pineda]

No me tira nungun error curiosamente... pero queda como cargando algo y sin fin, a lo mejor alguien mas prueba y que nos comenten

Saludos

[Antoni]

Hola Gerson:

¿ Has probado poniendo un punto de interrupción y seguir la UDF paso a paso ?

[Gerson Pineda]

Hola Antoni, no se si por mi manejo, pero he probado con punto de interrupcion y ni si quiera avanza... a lo mejor si alguien dice lo contrario

Saludos

[sailepaty]

De funcionar funciona, lo que no termino por conseguir es saber para que sirve:confused:

Saludos

[Antoni]

Hola:

Pues mira sailepaty, como soy muy olvidadizo y trabajo mucho con planificaciones que tienen totales de filas y columnas, decidí hacer esta UDF para asegurarme que si he incluido nuevas filas y columnas, no me haya olvidado de incluirlas en los totales.

Saludos. Antoni.

[sailepaty]

Entiendo, se ve que te es bastante útil.

Saludos