Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Makro? Sumujące czas pracy

olka258 · Świeżak Wersja: Win Office 365 Posty: 6

Hej, jeśli umieściłam temat nie tu gdzie trzeba to przepraszam i proszę o przekierowanie.

Mam plik który w jednej kolumnie ma nazwiska pracowników a w kolejnej przypisany do nich czas pracy np. Jan Nowak 2h, Anna Kowalska 4h, Barbara Marzec 4h, potem znowu Jan Nowak 6h itd. Wydaje mi się, że najlepiej byłoby wykorzystać makro, które po kliknięciu przycisku "oblicz", wyszukiwałoby wszystkie różne nazwiska i sumowało przepracowane godziny. Chodzi o to żebym wiedziała ile każdy z pracowników wypracował godzin w miesiącu. Tylko nie wiem jak napisać takie makro :-(

ewentualnie czy jest inna opcja na uzyskanie takiego efektu, z tym, że nie chciałabym dla każdego nazwiska wpisywać formuły tylko najlepiej właśnie przyciskiem który wyrzuci mi wszystkie nazwiska.

ąćęłńóś · Excel Expert **Pomógł:** 320 razy Posty: 1564

Witamy na forum,

Jakiś zupełnie przykładowy przykład by się przydał na ten przykład ... w pliku przykładowym

olka258 · Świeżak Wersja: Win Office 365 Posty: 6

@ąćęłńóś Dodałam plik, w kolumnie I jest czas poświęcony przez każdego pracownika, który chciałabym żeby się sumował.

Wskaźnik wtryskarka.xlsx
Plik

Pobierz Plik ściągnięto 18 raz(y) 12.47 KB

kuma · Wysłany: 15-02-2021, 15:01

Spróbuj coś takiego. Wyniki zaczynają się od 'L3'.

Kod:

Sub test_kuma()
Dim a()
Dim i As Integer
Dim d As Object

Set d = CreateObject("Scripting.Dictionary")
With Sheets("W").[d2].CurrentRegion
a = .Columns("c").Offset(2).Resize(.Rows.Count - 2, .Columns.Count - 2).Value
With d
For i = 1 To UBound(a)
If Len(Trim$(a(i, 1))) > 3 Then
If Not d.exists(a(i, 1)) Then
d.Item(a(i, 1)) = a(i, 6)
Else
d.Item(a(i, 1)) = d.Item(a(i, 1)) + a(i, 6)
End If
End If
Next
End With
With .Parent.[l3]
.CurrentRegion.ClearContents
With .Resize(d.Count)
.Value = Application.Transpose(d.keys)
.Columns.AutoFit
.Offset(, 1).Value = Application.Transpose(d.items)
.Offset(, 1).NumberFormat = "[h]:mm"
End With
End With
End With
Set d = Nothing
End Sub

olka258 · Świeżak Wersja: Win Office 365 Posty: 6

Nie cytuj całości jeśli odnosisz się do poprzedniego postu.

Super dziękuję!! A powiedz mi proszę w którym miejscu zmienić kod tak aby wyniki pojawiały się np. w kolumnie "P3" bo doszły mi 2 kolumny i już nie działa.

P.S. Działa, działa, tylko zapewne nie robi tego co powinien ;-)

Gdzie doszły te dwie kolumny? Czy kolumna 'czas realizacji w godzinach' przesunęła się w prawo?
Jeśli nie to spróbuj zmienić w kodzie

Kod:

With .Parent.[l3]

na

Kod:

With .Parent.[p3]

olka258 · Świeżak Wersja: Win Office 365 Posty: 6

Ok, już się poprawiam dzięki :-)

A jeszcze nie wiem czy to już nie za trudne ale jeśli mam jeszcze jedną kolumnę (J) z % wskaźnikiem wykonania ilości sztuk z kolumny G przez danego pracownika.

I chciałabym żeby wyliczało, może być obok czasu pracy albo osobno niżej, średnią z wszystkich jego (np. Adama Nowaka) wykonanych sztuk z tym, że chodzi mi o średnią z wszystkich arkuszy (poszczególne arkusze to różne maszyny na których pracownicy wykonują zlecenia).

Próbowałam najpierw zrobić takie coś z czasami na tym kodzie który wysłałeś wcześniej ale nie poszło :/

W załączniku plik

Kopia WskaĽnik wtryskarka-2.xlsm

Pobierz Plik ściągnięto 3 raz(y) 29.17 KB

Plantator · Wysłany: 16-02-2021, 20:11

Zrobiłem podobnie tylko na funkcjach, bez makr.

Wskaznik wtryskarka-3.xlsm

Pobierz Plik ściągnięto 4 raz(y) 31.89 KB

kuma · Wysłany: 16-02-2021, 21:11

Dobrze byłoby, abyś kod umieszczała w module normalnym VBA, a nie w module arkusza (tutaj tylko kody zdarzeniowe).

Wskaźnik wtryskarka-2_kuma.xlsm

Pobierz Plik ściągnięto 6 raz(y) 35.92 KB

olka258 · Świeżak Wersja: Win Office 365 Posty: 6

@plantator dzięki!

@kuma super działa :-D

a czy jest opcja aby przy każdym dodaniu nowego arkusza nie trzeba było modyfikować kodu przez uwzględnianie go tam? Tylko nie wiem domyślnie, że makro ma dotyczyć wszystkich arkuszy w pliku.

kuma · Wysłany: 18-02-2021, 09:40

Można to zrobić.
Musi być arkusz o nazwie 'W0', a następne dodawane arkusze będą z nazwami 'W1', 'W2', itd.
Kod pomija inne nazwy arkuszy
Wynik będzie zawsze w arkuszu 'W0'.

Kod:

Sub test_kuma()
Dim a(), shts, sh, hdrs, v
Dim i As Integer, ii As Integer
Dim d As Object
Dim ms As String

hdrs = [{"Imie i nazwisko","Suma czasu","Średnia"}]

Set d = CreateObject("Scripting.Dictionary")
With d
For ii = 0 To Sheets.Count - 1
If Sheets(ii).Name Like "W" & ii Then
With Sheets("W" & ii).[d2].CurrentRegion
a = .Columns("c").Offset(2).Resize(.Rows.Count - 2, .Columns.Count - 2).Value
End With
For i = 1 To UBound(a)
If Len(Trim$(a(i, 1))) > 3 Then
If Not d.exists(a(i, 1)) Then
d.Item(a(i, 1)) = a(i, 6) & "|" & a(i, 4) / a(i - 1, 4) & "|" & 1
Else
v = Split(d.Item(a(i, 1)), "|")
d.Item(a(i, 1)) = v(0) + a(i, 6) & "|" & v(1) + a(i, 4) / a(i - 1, 4) & "|" & v(2) + 1
End If
End If
Next
End If
Next
End With
Application.ScreenUpdating = False
With Sheets("W0").[p3]
.CurrentRegion.ClearContents
.Resize(, 3).Value = hdrs
For i = 0 To d.Count - 1
v = Split(d.items()(i), "|")
.Offset(i + 1).Resize(, 3).Value = Array(d.keys()(i), CDbl(v(0)), v(1) / v(2))
Next
With .CurrentRegion
.Columns(2).NumberFormat = "[h]:mm"
.Columns(3).NumberFormat = "0.00%"
.Columns(1).Resize(, 3).AutoFit
End With
End With
Set d = Nothing
End Sub

olka258 · Świeżak Wersja: Win Office 365 Posty: 6

Dzięki bardzo za pomoc :-)