Macro que busque y modifique valores

La situación normal es que las finales de un día sean las iniciales del día siguiente, pero al realizar un cambio de equipo, el valor ya no será el mismo. El problemas es cómo programar una macro que busque en un rango el número del equipo cambiado y modifique su valor inicial del día siguiente de manera automática. Ojalá me haya explicado bien. Adjunto libro

1 Respuesta

Respuesta
1

Podrías poner varios ejemplos con datos reales y también en qué celdas pones las fechas, los equipos, etc.

Puedes enviarme el archivo a mi correo.

[email protected]

O bien puedes subir imagen de la pantalla de excel a

subeimagenes.com

Saludos. Dam

Muy bien. Gracias. Ya te lo envié.

En la celda I5 tienes la fórmula

=E5

Cámbiala por esta:

=SI(ESERROR(BUSCARV(H5,$H$12:$J$16,3,0)),E5,(BUSCARV(H5,$H$12:$J$16,3,0)))

Y copia esta fórmula en todas tus celdas Inicial

Saludos. DaM

Gracias, pero no entiendo la sintaxis. Hice lo que me dices, pero no me da resultado? No será mejor con una macro? Aunque si así funciona esta bien, pero necesito entender para adaptarla a lo que quiero.

Coloqué un cambio en el equipo 1 y los valores de todos los equipos cambiaron, cuando la idea era que cambiara sólo la inicial del 1. Pero lo hice con el 4 y lo cambio bien. Por eso te pregunto la lógica que usaste.

Gracias de nuevo.

Perdona, me equivoqué de fórmula, en la celda I5 pon la siguiente :

=SI(ESERROR(BUSCARV(H5,C$12:E$16,3,0)),E5,(BUSCARV(H5,C$12:E$16,3,0)))

Después de ponerla en I5, copiala en todas tus celdas "Inicial".

Lo que hace la fórmla es:

Primero te explico que la siguiente función

La función ESERROR regresa VERDADERO si existe error, es decir, si te regresa un valor #N/A o #NOMBRE, etc.

Entonces la fórmula hace:

Busca H5 (equipo), en C12 a E16 (Cambio de equipo) del día anterior, si no encuentra el equipo, excel envía un error, por eso le antepuse la pregunta "ESERROR", entonces si no lo encuentra, que ponga el valor de la celda E5. Si no es error, entonces le pido que haga nuevamente la búsqueda, ya que la primera búsqueda sirvió para comprobar si era Error, hace la búsqueda y le pido que me regrese el valor de la 3ra columna, para eso es el número 3 que ves en la fórmula, es decir, le pido que me traiga el valor de la columna final.

Espero que me haya podido explicar.

Aplica la nueva fórmula que te estoy enviando para que la entiendas.

Para la macro, necesito que me envíes tu archivo completo, porque supongo que tienes más de 4 equipos, entonces, ni la fórmula ni la macro funcionarían, por ejemplo, para el equipo 5 ó 6 ó 7, etc. Tal vez tendrías que cambiar el diseño de tu hoja, para tener más equipos hacia abajo y que los cambio de equipos, no estén justo abajo, de lo contrario vamos a batallar para hacer algo automático.

Si por el momento te funciona la fórmula, por favor, cierra la pregunta, y crea una nueva con la funcionalidad para poder manejar más equipos.

Saludos. Dam

Épale!! Disculpa la tardanza, pero no tenía Internet.

Entiendo la lógica, pero aún no funciona.

Te enviaré un archivo más completos como sugieres.

Gracias pana.

Ayudame con lo siguiente:

1. ¿Este título “Cambio de Equipo / Equipo Colocado” siempre dice lo mismo en cada día?
2. Tus hojas, siempre se llaman “lunes”, “¿martes”?, necesito que me digas los nombres correctos de todas tus hojas de toda la semana
3. ¿Qué pasa con los siguientes meses?
4. ¿Tienes varios libros?

Hola!1. Si dice Cambio de Equipo / Equipo Colocado todos los días.

2. Realmente son 7 hojas, con los nombres de cada día.

3. Los valores iniciales pasan de hoja a hoja y de libro a libro al final de la semana, es decir, de domingo de un libro a lunes de otro libro.

4. Se hace tantos libros como semanas tiene cada mes.

Gracias

Pero necesito los nombres, para decirle a la macro exactamente que del libro "semana 2" hoja "lunes" tome el valor del libro "semana 1" hoja "domingo".

Si no es posible que me des los nombre o que los nombres sean muy variados, entonces cuando inicie la macro que te pida: cuáles son los libros y las hojas.

Saludos. Dam

Son Variados, pero ponle al libro 1 "semana_01" y al 2 "semana_02" y yo le cambio el nombre en la macro. Para que no me lo pregunte cada vez que lo abra.

Te anexo una macro, por favor revisa lo siguiente:
1. Tus libros de la semana y del mes, deberán estar en la misma carpeta
1.1 Los nombres del libro y la hoja de ayer los pones al inicial la macro.
1.2 Los nombres del libro y la hoja de hoy también los pones al iniciar la macro
2. En todas tus hojas de la semana (lun, mar … dom), los números de equipo deberán empezar en la columna D, (no importa que esté combinada la celda)
3. La lectura final, deberá estar en la columna I (no importa que esté combinada la celda)
4. No importa cuantos equipos tengas.
5. No importa cuantos equipos en la sección de “Cambio de Equipo” tengas.
6. Lo importante es que la sección siempre empiece con la frase “Cambio de Equipo”
7. Deberás crear un archivo que se llame “control eq”
8. Sigue las siguientes instrucciones para ejecutar la macro:
8.1. Abre el libro “control eq”
8.2. Para abrir Vba-macros y poder pegar la macro, Presiona ALt + F11
8.3. En el menú elige Insertar / Módulo
8.4. En el panel del lado derecho copia la macro
8.5. Tienes que cambiar la siguiente
8.5. Para ejecutarla presiona F5
9. Si quieres cambiar el directorio inicial cambia esta línea:
"CARPETA EQUIPOS", 0, "C:"). Items. Item. Path
Por ejemplo por esta
"CARPETA EQUIPOS", 0, "C: \Documents and Settings"). Items. Item. Path

'***Macro***
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public libroayer, librohoy, hojaayer, hojahoy, wcontrol As String
Public eqhoy As Long
Public ufilaCt As Integer
Sub lasultimassonlasprimeras()
'Por.dam
On Error Resume Next
Dim wBook As Workbook
Dim RngEquipo As Range
Dim lecturafinal As Variant
Application.StatusBar = "Procesando semanas"
Application.ScreenUpdating = False
wError = 0
wcontrol = "control eq"
Workbooks(wcontrol).Activate
Worksheets("Hoja1").Select
    ufilaCt = Range("A" & Rows.Count).End(xlUp).Row
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, _
"CARPETA EQUIPOS", 0, "C:").items.Item.Path
ChDir carpeta & "\"
enumber = Err.Number
libroayer = InputBox("Libro Ayer : ")
hojaayer = InputBox("Hoja Ayer : ")
librohoy = InputBox("Libro Hoy : ")
hojahoy = InputBox("Hoja Hoy : ")
Application.ScreenUpdating = True
'Workbooks(wcontrol).Activate
'Worksheets("Hoja1").Select
ponerror ("inicio")
Application.ScreenUpdating = False
Set wBook = Workbooks(libroayer)
If wBook Is Nothing Then
    Workbooks.Open Filename:=libroayer
    Err.Number = 0
Else
    Workbooks(libroayer).Activate
End If
If Err.Number = 0 Then
    Worksheets(hojaayer).Select
    If Err.Number = 0 Then
        ufilaayer = ActiveCell.SpecialCells(xlLastCell).Row
        'La hoja si existe
        Range("D:F").Select
        Set Rangoayer = Selection.Find(What:="Cambio de Equipo", _
            After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)
        If Not Rangoayer Is Nothing Then
            'El renglón existe PUEDE procesar
            fila_inter_ayer = Rangoayer.Row
            wError = 0
            Range("D1").Select
        Else
            'El renglón no existe
            ponerror ("err_renglon")
            wError = 1
        End If
    Else
        'La hoja no existe
        ponerror ("err_hoja")
        wError = 1
    End If
Else
    'El libro producto no se pudo activar
    MsgBox (Err.Number)
    ponerror ("err_libroproducto")
    wError = 1
    MsgBox (Err.Number)
End If
If wError = 0 Then
'Abre hoja de hoy para pegar los nuevos datos
Set wBook = Workbooks(librohoy)
If wBook Is Nothing Then
    Workbooks.Open Filename:=librohoy
Else
    Workbooks(librohoy).Activate
End If
If Err.Number = 0 Then
    Worksheets(hojahoy).Select
    If Err.Number = 0 Then
        ufilahoy = ActiveCell.SpecialCells(xlLastCell).Row
        Range("D:F").Select
        Set Rangohoy = Selection.Find(What:="Cambio de Equipo", _
            After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)
        If Not Rangohoy Is Nothing Then
            'El renglón existe inicia proceso
            Range("D1").Select
            fila_inter_hoy = Rangohoy.Row
            wError = 0
            For i = 6 To fila_inter_hoy
                Worksheets(hojahoy).Select
                If Cells(i, 4) > 0 Then
                    eqhoy = Val(Cells(i, 4))
                    Workbooks(libroayer).Activate
                    Worksheets(hojaayer).Select
                    'Busca equipo en cambio de equipo
                    Set RngEquipo = Range("D" & fila_inter_ayer + 1 & ":I" & ufilaayer - 1)
                    lecturafinal = Application.WorksheetFunction.VLookup(eqhoy, RngEquipo, 6, False)
                    If Not lecturafinal = "" Then
                        'lectura_final = Cells(RngEquipo.Row, 9)
                        Workbooks(librohoy).Activate
                        Worksheets(hojahoy).Select
                        Cells(i, 7) = lecturafinal
                        lecturafinal = ""
                    Else
                        'Busca equipo en normal
                        Set RngEquipo = Range("D5:I" & fila_inter_ayer - 1)
                        lecturafinal = Application.WorksheetFunction.VLookup(Val(eqhoy), RngEquipo, 6, False)
                        If Not lecturafinal = "" Then
                            Workbooks(librohoy).Activate
                            Worksheets(hojahoy).Select
                            Cells(i, 7) = lecturafinal
                            lecturafinal = ""
                        Else
                            ponerror ("err_equipo")
                        End If
                    End If
                End If
            Next
        Else
            ponerror ("err_renglon")
        End If
    Else
        ponerror ("err_hoja")
        wError = 1
    End If
Else
    ponerror ("err_libro")
    wError = 1
End If
End If 'Fin de error <> 0
'Termino un libro
ponerror ("terminado")
Application.ScreenUpdating = True
Worksheets(wcontrol).Select
MsgBox ("Proceso Terminado " & vbNewLine & "Revisar Control")
Application.StatusBar = False
End Sub
Sub ponerror(tipo)
ufilaCt = ufilaCt + 1
Workbooks(wcontrol).Activate
    Cells(ufilaCt, 1).Value = Date
    Cells(ufilaCt, 2).Value = libroayer
    Cells(ufilaCt, 3).Value = hojaayer
    Cells(ufilaCt, 4).Value = librohoy
    Cells(ufilaCt, 5).Value = hojahoy
    Cells(ufilaCt, 6).Value = eqhoy
Select Case tipo
    Case "inicio"
        Cells(ufilaCt, 7).Value = "En proceso"
    Case "err_hoja"
        Cells(ufilaCt, 7).Value = "Hoja no se pudo activar"
    Case "err_renglon"
        Cells(ufilaCt, 7).Value = "No se encontró la frase: Cambio de Equipo /  Equipo Colocado"
    Case "err_equipo"
        Cells(ufilaCt, 7).Value = "El equipo no se encuentra en ayer"
    Case "terminado"
        Cells(ufilaCt, 7).Value = "Terminado"
End Select
End Sub
'***Macro***

Revisa la macro, si te funciona, por favor, podrías cerrar la pregunta.
Si tiene fallas con gusto la reviso.
Cualquier mejora, deberás abrir una nueva pregunta.
Saludos. Dam

Bárbaro!! No pensé que sería un código tan largo.

Cree el Libro, ejecuté la macro, cambié la ubicación de las lecturas tal como lo indicaste.

No se consiguieron los objetivos, sólo me copia los datos de los InputBox en el libro control eq, además de colocar si el proceso termino.

Así que no se chamo!

Parece difícil.

Mándame tu archivo con el que hiciste la prueba.

[email protected]

Si funcionó! Era un error de mi parte, pero el problema es que todo este
proceso debe ser automático, sin que el usuario final tenga la
necesidad de ejecutar una macro en otro libro o de colocar los nombres
de los libros, ya que a pesar de que varían, sería bueno cambiar la dirección del libro dentro del código o actualizar un vinculo.

De verdad te felicito por la agilidad desarrollada en excel y VBA.

Esta pregunta la doy como finalizada, pero si crees conveniente abrir otra para conseguir el resultado, me avisas.

Gracias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas