VBA - Mensaje de espere

[Laufwerk]

Hola!!
Necesito algo que pueda mostrar al usuario, pero que continue trabajando por detrás.

Estoy haciendo varias operaciones con tablas y tarda como 3 o 4 min, entonces me gustaria mostrar una barra de progreso o un mensaje de "Espere..." y al finalizar el código se cierre.


Gracias

[Laufwerk]

Hasta ahora he conseguido mostrar un formulario, pero hasta que no cierro no empieza a hacer las operaciones.

Como lo soluciono?



PD: no dejeis de contestarme el primer post, ya que me gustaria poner una barra de progreso, o una imagen gif de load

[3pies]

No es normal que te dure 3 o 4 minutos. Yo tengo hojas con casi 1.400 líneas de código, y me tarda entre 5 y 10 segundos.

¿Seguro que has puesto como primera línea del macro, esto:

Código:

Application.ScreenUpdating = False

Si aún así crees que debes mostrar algo al usuario, dado el tiempo que tarda, lo ideal sería una barra de progreso. Creo que en este mismo foro hay algo sobre eso (usa el buscador del foro).

Salu2

[Laufwerk]

quizás exageré con 3 o 4 min, pero tarda más de 1 min seguro.
Lo que hacen mis macros es buscar si el valor del campo existe en el segundo fichero abierto, recorriéndolo fila por fila del primero al segundo.
te pongo el codigo

Código:

    
For i = 2 To numRows(1)                                      ' Filas del primer archivo
        For j = 2 To numRows(2)                              ' Filas del segundo archivo
            'MsgBox Worksheets(2).Range("C" & i).Value
            'windows(myBook(i)).
            
            If (Workbooks(2).Worksheets(1).Range(varCellOriginalColumn & i).Value = Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & j).Value) Then
                encontrada = True
                pos = j
                Exit For
            End If
        Next j
        
        If encontrada Then
            Windows(myBook(2)).Activate
            Workbooks(3).Sheets(1).Select
            valueSearch = Range(varCellDestinyCopy & pos).Value
            'drawColorRow (pos)
            Selection.Copy
            Windows(myBook(1)).Activate
            Workbooks(2).Sheets(1).Select
            Range(varCellInsertColumn & i).Value = valueSearch
            'drawColorRow (i)
            'ActiveSheet.Paste
        Else
            Windows(myBook(1)).Activate
            Rows(i & ":" & i).Select
            Range("N" & i).Activate
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next i

el Application.ScreenUpdating = False ya lo tengo, pero para el form no me sirve

[3pies]

Mírate estos hilos: http://www.forosdelweb.com/search.php?searchid=2238987

[mrocf]

Hola! Laufwerk. Si reemplazas el bucle

For j
Next j

por lo siguiente, posiblemente llegues a una sustancial disminución del tiempo de operación:

Código:

Dim Celda As Range

For i = 2 To numRows(1) ' Filas del primer archivo
  Set Celda = Range(Range(Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & 2)), _
    Range(Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & numRows(2)))).Find( _
    What:=(Workbooks(2).Worksheets(1).Range(varCellOriginalColumn & i).Value), _
    LookIn:=xlValues, LookAt:=xlWhole)
        
  If Not Celda Is Nothing Then
    Windows(myBook(2)).Activate
    valueSearch = Celda.Value
    'drawColorRow (pos)
    Selection.Copy
    Windows(myBook(1)).Activate
    Workbooks(2).Sheets(1).Select
    Range(varCellInsertColumn & i).Value = valueSearch
    'drawColorRow (i)
    'ActiveSheet.Paste
  Else
    Windows(myBook(1)).Activate
    Rows(i & ":" & i).Select
    Range("N" & i).Activate
    With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .ThemeColor = xlThemeColorAccent2
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
  End If
Next i

Set Celda = Nothing

Comenta -por favor- como te ha ido, ¿ok?

Saludos, Cacho.

[Laufwerk]

podrias explicarme que hace tu codigo?

merci!!!!

[mrocf]

Es sencillo. Mientras que

Código:

For j = 2 To numRows(2)
If (Workbooks(2).Worksheets(1).Range(varCellOriginalColumn & i).Value = Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & j).Value) Then
    encontrada = True
    pos = j
    Exit For
  End If
Next j

recorre -una a una- las celdas del rango que se inicia en la celda
Workbooks(3).Worksheets(1).Range(varCellDestinyCol umn & "2")

hasta la celda
Workbooks(3).Worksheets(1).Range(varCellDestinyCol umn & numRows(2))

buscando cual de ellas contiene el mismo valor que
Workbooks(2).Worksheets(1).Range(varCellOriginalCo lumn & i)

el código

Código:

Set Celda = Range(Range(Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & 2)), _
    Range(Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & numRows(2)))).Find( _
    What:=(Workbooks(2).Worksheets(1).Range(varCellOriginalColumn & i).Value), _
    LookIn:=xlValues, LookAt:=xlWhole)

equivale al comando "Buscar" (Ctrl + B) del Excel ("Find" en inglés).

Como este comando es "inmensamente" más rápido que buscar -una a una- en las celdas del rango en cuestión la igualdad, deberías notar la diferencia inmediatamente.

Investiga en la ayuda del VBA sobre las características del método "Find": verás que devolverá como resultado una celda.

De allí es que, más abajo en tu código, reemplacé:
valueSearch = Range(varCellDestinyCopy & pos).Value

por:
valueSearch = Celda.Value

Cualquier otra duda comenta, ¿si?.
Saludos, Cacho.

[Laufwerk]

Al final me decidí a poner su código , ya que era más rápido y buscaba cualquier campo. El mio no podia comparar un campo tipo numero con un campo tipo texto aunque fura un numero.
Copié y pegué su código sustituyendo a mi bucle for y su posterior If, y me encuentro con un error:
Dice asi:
Se ha producido el error '1004' en tiempo de ejecución:
Error en el método 'Range' de objeto '_Global'

puedes echarme una mano?

encontré un fallo en el código que me pasastes:
tu me pusistes:

Código:

  Set Celda = Range(Range(Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & 2)), _
    Range(Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & numRows(2)))).Find( _
    What:=(Workbooks(2).Worksheets(1).Range(varCellOriginalColumn & i).Value), _
    LookIn:=xlValues, LookAt:=xlWhole)

Marcado en rojo numrows(2) ya no existe, asi que puse numRows(1),
pero me tira el error comentado anteriormente.

Qué puedo hacer?

[Laufwerk]

Tengo nuevas modificaciones chicos.
Si antes no me salia, ahora creo que tampoco me saldrá.
Pues bien, os explico la nueva funcion
Tengo dos archivos excels abiertos y tengo que comparar dos columnas.

Hasta aqui bien, pero tengo que hacerlo de la siguiente manera.
Del archivo 1 al archivo 2
- Si el valor de una celda del archivo 1 lo encuentra en el archivo 2, copiar el contenido de otra columna del archivo2 al arachivo 1, pero misma fila donde encontró la celda igual al archivo 1
- Si el valor de la celda no lo encuentra en el archivo 2, marcar la celda o la fila del archivo 1 en rojo.
Así para toda la columna del archivo 1

Del archivo 2 al archivo 1
- Si el valor de una celda del archivo 2 lo encuentra en el archivo 1, no haremos nada
- Si el valor de una celda del archivo 2 NO lo encuentra en el archivo1, marcarermos la fila o la celda en rojo.
Y así también para toda la columna del archivo 2.


Gracias, por vuestra atención,

PD: Si no me he explicado claro, preguntadme y con mucho gusto os responderé tan pronto pueda.

[mrocf]

Observa que -en tu código original- tenías:

For i = 2 To numRows(1) ' Filas del primer archivo
For j = 2 To numRows(2) ' Filas del segundo archivo
Next j

lo cual indica que:
a) O ya no te funcionaba desde antes tu código; ó
b) Has cometido un error al transcribir el código sugerido.

De todos modos, la necesidad que -ahora- describes tiene solución inmediata NO con los códigos utilizados sino a través de la función de Excel

BUSCARV()

o con la combinación:

INDICE( COINCIDIR() )

¿Por qué no intentas analizar esa variante... primero "a mano" y luego -grabadora de macros mediante- a través de código VBA?.

Saludos, Cacho.

[Laufwerk]

pero buscarV se puede hacer entre dos libros?

Con un ejemplo senzillo lo veria mas claro.

Mi código funciona, comprobado
El código que me pegaron no funciona ya que numRows(2) no existe, no dudo que sepan hacerlo, y seguramente muchísimo mejor que yo.

Gracias por conprenderme y por darme ejemplos.

[mrocf]

Oye, Amigo: intenta analizar con mayor profundidad lo que te sugerimos:

Si "numRows(2)" funcionaba en tu código original, no hay razón para que no funcione en el alternativo... Estudia el tema con mayor detenimiento y busca -en tu código original- cuando toma valor ese vector.
Pues: lo mismo debe ocurrie en el código alternativo.

En otro orden de cosas, te indico que BUSCARV() funciona entre libros, por supuesto. Un ejemplo sería la siguiente fórmula puesta en el "Libro1":

= BUSCARV(A2; [Libro2]Hoja5!$A$1:$B$16; 2; FALSO)

Aquí se está buscando el contenido de la celda A2 del Libro1, en el rango $A$1:$B$16 de la Hoja5 del Libro2. Si ese valor se encuentra, se devuelve el contenido de la columna "B" del rango.

Para tu caso particular, si no se encuentra el valor buscado, se devolverá un error.
Ese error, lo buscarás a posteriori y efectuarás el cambio de formato que deseas.

Saludos, Cacho.

[Laufwerk]

sigo peleandome con el método find que me pasasteis y no encuentro el error. Sin embargo, me he echo una macro para saber que codigo Find me ponía y es el siguiente.

Código:

    Columns("C:C").Select
    Selection.find(What:="634142263", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

Quisiera saber si el codigo de arriba me devuelve algo, en caso de que si, cómo accedo al valor?

Imagino que todo el codigo que me pusistes antes del find

Código:

Set celda = Range(Range(Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & 2)), _
    Range(Workbooks(3).Worksheets(1).Range(varCellDestinyColumn & numRows(2)))).

, equivale al

Código:

Columns("C:C").Select 
Selection.

que me ha creado la macro.
También veo que la macro me pone mas valores de configuración del Find.

Pero el codigo me peta en el primer bucle, me dice que "Error en el método 'Range' de objeto '_Global'"


La busqueda la tengo que hacer en los dos sentidos, es decir, por ejemplo :
tengo que mirar los campos de la columna "c" del libro1, que esten en la columna "C" del libro2, los que no se encuentren marcar la fila de la columna "C" que estaba buscando en rojo del libro1. Después la inversa.


Gracias por vuestra paciencia

[Laufwerk]

Al final consegui hacerlo. Les pongo el codigo.

Código:

Sub CompareCols()
    'Auto_Open
    encontrada = False
    Dim celda As Range
    Dim rango As Range
    For i = 2 To numRows(1)
        Dim valor As String
        valor = Workbooks(2).Worksheets(1).Range(varcellOriginalColumn1 & i).Value
        
        Windows(myBook(2)).Activate
        Set rango = Range(varCellDestinyColumn1 & 2, varCellDestinyColumn1 & numRows(2))
        
        Set celda = rango.find(What:=valor, LookIn:=xlValues, LookAt:=xlWhole)

      If Not celda Is Nothing Then
        Windows(myBook(2)).Activate
        rowPos = celda.Row
        valueSearch = Range(varCellDestinyCopy & rowPos).Value
        'valueSearch = celda.Value
        'drawColorRow (pos)
        'Selection.Copy
        Windows(myBook(1)).Activate
        Workbooks(2).Sheets(1).Select
        Range(varCellInsertColumn & i).Value = valueSearch
        'drawColorRow (i)
        'ActiveSheet.Paste
      Else
        Windows(myBook(1)).Activate
        Rows(i & ":" & i).Select
        Range("N" & i).Activate
        With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent2
          .TintAndShade = 0
          .PatternTintAndShade = 0
        End With
      End If
    Next i
    
    Set celda = Nothing
    Windows(myBook(2)).Activate
    Columns(varCellInsertColumn & ":" & varCellInsertColumn).EntireColumn.AutoFit
End Sub

Ahora mi proximo paso es comparando dos columnas, si teneis alguna sugerencia....

Gracias!!!!

[Laufwerk]

Hola de nuevo!!
El problema anterior ya lo solucioné.
Pero ahora quiero ponerle el dichoso mensaje de espere mientras hacemos los calculos.

Pero si abro el form, hasta que no lo cierro no continua con las operaciones.

Este form lo muestro desde que clico en el boton generar hasta que finaliza dicha operación.

Cómo lo hago?


Gracias

[Taribo007]

Quiza puedas adaptar este ejemplo de access:

mensaje Ejecutando tareas

Un saludo