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
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
.
