MACROS de 2 hojas diferentes ubicar fecha y poner horas en una sola

Tengo 2 archivos de excel diferentes, de los cuales quiero juntar la información a uno:

Los datos del archivo de la izquierda quiero pasarlos al de la derecha, el cual será mi archivo final. El archivo de la izquierda contiene:

-Fecha, el cual sirve para ubicar en el archivo de la derecha.

-Equipo, con este y la fecha se hace una intersección en el archivo de la derecha.

-Duración, a partir de la intersección se pone la duración, 24 hrs máximo por día, en esto ya me apoyastes, te dejo la macro abajo. Ejm si es 49hrs, se pondría 24 - 24 - 1.

-Tipo, solo tiene 3, si es X donde ponga la duración que aparezca en rojo, Y=verde, Z=azul. En el ejemplo anterior 49 hrs, se reparte 24 - 24 - 1 y si es X en tipo que se pinte de rojo las celdas.

Mi problema esque no puedo enlazarlo con el tipo y pinte de color, ademas de trabajar en 2 hojas diferentes para formar solo una. Estoy muy agradecido con todo el apoyo que brindas. Lineas abajo te dejo la macro anterior en donde se trabajaba solo en una hoja.

Sub Macro5()
'------
'   Por.Dante Amor
'------
    Range(Cells(3, "E"), Cells(Rows.Count, Columns.Count)).ClearContents
    For i = 3 To Range("B" & Rows.Count).End(xlUp).Row
        fecha = Cells(i, "B")
        horas = Cells(i, "C")
        Set b = Rows(2).Find(fecha, lookat:=xlWhole)
        If Not b Is Nothing Then
            col = b.Column
            Do While horas > 0
                Cells(i, col) = IIf(horas > 24, 24, horas)
                col = col + 1
                horas = horas - 24
            Loop
        End If
    Next
    MsgBox "fin"
End Sub

1 respuesta

Respuesta
2

Te anexo la macro

Sub Macro5()
'------
'   Por.Dante Amor
'------
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    h2.Range(h2.Cells(3, "B"), h2.Cells(Rows.Count, Columns.Count)).Clear
    '
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        fecha = h1.Cells(i, "A")
        equip = h1.Cells(i, "B")
        horas = h1.Cells(i, "C")
        tipos = h1.Cells(i, "D")
        Select Case UCase(tipos)
            Case "X":  wcolor = 3
            Case "Y":  wcolor = 4
            Case "Z":  wcolor = 5
            Case Else: wcolor = xlNone
        End Select
        Set b = h2.Rows(1).Find(fecha, lookat:=xlWhole)
        If Not b Is Nothing Then
            col = b.Column
            Set b = h2.Columns("A").Find(equip, lookat:=xlWhole)
            If Not b Is Nothing Then
                fil = b.Row
                Do While horas > 0
                    h2.Cells(fil, col) = IIf(horas > 24, 24, horas)
                    h2.Cells(fil, col).Interior.ColorIndex = wcolor
                    col = col + 1
                    horas = horas - 24
                Loop
            Else
                h1.Cells(i, "E") = "No existe el equipo"
            End If
        Else
            h1.Cells(i, "E") = "No existe la fecha"
        End If
    Next
    MsgBox "fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas