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
Les pido disculpas,
No me presenté, soy Martin Sacchi Ing. Civil. Estoy armando un tablero de control para las distintas obras en supervisión.
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í:
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 SubAndy M.