VBA excel, agregar y acumular datos

Contexto:

A diario recibo un libro excel con un listado de personal en columna A y horas trabajadas en la columna B, además tengo un listado donde voy acumulando horas trabajadas de todos los días anteriores.

Los nombres no siempre están ordenados alfabéticamente y puede ser que a diario se agregue personal.

Hoja1 Origen de datos - esquema: Columna A(id persona(dato único)) Columna B (hs trabajadas)

Hoja2 Destino de datos - esquema: Columna A(id persona(dato único)) Columna B (hs trabajadas acumuladas)

La macro debería comparar las Columnas A de ambas hojas, si un nombre que está en hoja1 no se encuentra en hoja2 debería agregar ambas columnas (A y B) en hoja2, si el nombre ya se encuentra debería acumular (en hoja2) las horas que ya se encontraban en columna B de hoja2 con las horas de columna B de hoja1

2 respuestas

Respuesta
1

Les pido disculpas,

No me presenté, soy Martin Sacchi Ing. Civil. Estoy armando un tablero de control para las distintas obras en supervisión.

Respuesta
1

Habia leído esta pregunta en el teléfono y dije, cuando llegue a casa la respondo, pero me olvide, y la vi otra vez ahora.

Hice una captura en vídeo simulando lo que entiendo que necesitas. Puedes ver la pequeña grabación aquí:

Macro Demo

Si eso es lo que necesitas, este es el código que escribí para lograr eso:

Sub MartinSacchi()
Dim rCell As Range
Dim rRng As Range
Dim Rng As Range
Dim uF1 As Long
Dim uF2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ID As String
Set ws1 = Sheets("Hoja1")
Set ws2 = Sheets("Hoja2")
uF1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
Set rRng = ws1.Range("A2:A" & uF1)
For Each rCell In rRng.Cells
    ID = rCell.Text
    If Trim(ID) <> "" Then
        With ws2.Range("A:A")
            Set Rng = .Find(What:=ID, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Rng.Offset(0, 1).Value = Rng.Offset(0, 1).Value + rCell.Offset(0, 1).Value
            Else
                uF2 = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
                ws2.Range("A" & uF2).Value = rCell.Value
                ws2.Range("B" & uF2).Value = rCell.Offset(0, 1).Value
            End If
        End With
    End If
Next rCell
End Sub

Andy M.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas