Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 68599 Skopiuj do schowka Suma godzin
Autor Wiadomość
bigosiak 
Exceloholic


Pomógł: 1 raz
Posty: 122
Wysłany: 27-07-2020, 09:53   Suma godzin

Witam po przerwie.
Mam listę z nazwiskami w kolumnie F i liczbe godzin w kolumnie N.
Ma ktoś ochotę napisać makro aby uzyskać podsumowanie z tej listy?
Np Jan Kowalski - 37.5, Stas Matwa - 30 itd...
W przykładzie jest kilka nazwisk ale lista może być długa na 100-120 nazwisk.
Dziękuje.
Pozdrawiam

Przyklad.xlsx
Pobierz Plik ściągnięto 5 raz(y) 13.14 KB

ID posta: 390192 Skopiuj do schowka
 
 
Kaper 



Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4191 razy
Posty: 7818
Wysłany: 27-07-2020, 10:08   

Właściwie można napisać makro, ale po co, skoro tworzona bodaj siedmioma kliknięciami tabela przestawna daje oczekiwany wynik (dwa z tych sedmiu kliknięć są nieco oszukane - oprócz kliknięcia nadałem nazwy kolumnom czyli wpisałem kilkanaście liter, ale w prawdziwym pliku pewnie masz te kolumny opatrzone nagłówki8em, a nawet jeśli nie, to możesz ten nagłówek raz dopisać, a potem wielokrotnie używać), czyli de facto kliknięć było potrzebnych pięć :-) .

Zeszyt2.xlsx
Pobierz Plik ściągnięto 5 raz(y) 18.29 KB

_________________
Kaper Jej Królewskiej Mości :boss

Jeśli dane będą torturowane dość długo, przyznają się do wszystkiego
ID posta: 390194 Skopiuj do schowka
 
 
bigosiak 
Exceloholic


Pomógł: 1 raz
Posty: 122
Wysłany: 27-07-2020, 10:38   

Dziękuje - musze zatem się pobawić tabelami...
ID posta: 390198 Skopiuj do schowka
 
 
Kaper 



Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4191 razy
Posty: 7818
Wysłany: 27-07-2020, 12:18   

A przykładowe makro mogłoby wyglądać tak:
Kod:
Sub test()
Dim dict As Object, lr As Long, i As Long, arr1 As Variant, arr2 As Variant
Set dict = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "F").End(xlUp).Row
arr1 = Range("F15:F" & lr).Value
arr2 = Range("N15:N" & lr).Value
For i = 1 To UBound(arr1)
  If dict.Exists(arr1(i, 1)) Then
    dict(arr1(i, 1)) = dict(arr1(i, 1)) + arr2(i, 1)
  Else
    dict.Add arr1(i, 1), arr2(i, 1)
  End If
Next i
For i = 0 To dict.Count - 1 ' jeśli nazwisk byłoby naprawdę dużo to najpierw zapisać
' dane do tablicy a potem tablicę do arkusza, a nie po kolei zapis komórka po komórce
  Cells(lr + 4 + i, "B") = dict.Keys()(i)
  Cells(lr + 4 + i, "C") = dict.Items()(i)
Next i
End Sub
_________________
Kaper Jej Królewskiej Mości :boss

Jeśli dane będą torturowane dość długo, przyznają się do wszystkiego
ID posta: 390207 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 662 razy
Posty: 3481
Wysłany: 27-07-2020, 12:38   

Albo tak:
Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim d&, i&, n$, s As Double, j&, sk As Double

d = Cells(Rows.Count, "F").End(xlUp).Row
Range("F15:N" & d).Sort key1:=Range("F15:F" & d), order1:=xlAscending, Header:=xlNo

j = 15
n = Cells(j, 6).Value
s = 0
sk = 0
Cells(j, 18).Value = n
s = s + Cells(j, 14).Value

For i = 16 To d + 1
    If Cells(i, 6).Value = n Then
        s = s + Cells(i, 14).Value
    Else
        sk = sk + s
        Cells(j, 19).Value = s
        n = Cells(i, 6).Value
        j = j + 1
        Cells(j, 18).Value = n
        s = Cells(i, 14).Value
    End If
Next i

Cells(j, 19).Value = sk

End Sub


Kopia Przyklad.xlsm
Pobierz Plik ściągnięto 4 raz(y) 26.14 KB

_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390209 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe