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: 73411 Skopiuj do schowka Makro-Tworzenie tabeli z wart. z wybranych arkuszy i wierszy
Autor Wiadomość
Ptaszko
Forumowicz


Wersja: Win Office 365
Posty: 11
Wysłany: 24-09-2022, 16:21   Makro-Tworzenie tabeli z wart. z wybranych arkuszy i wierszy

Witam.
Bardzo proszę o pomoc w napisaniu makra do zliczania w tabeli wartości z arkuszy z wierszy.
Założenia: (załączony plik pomocniczy).
1. Posiadam skoroszyt - Karta płac, zawierający wiele arkuszy (może być ich od 1 do nawet 200).
2. Każdy arkusz jest nazwany Imieniem i nazwiskiem pracownika.
3. W każdym arkuszu znajduje się 14 kolumn, ale może ich być mniej w zależności od zatrudnienia danego pracownika. Zawsze w ostatniej kolumnie znajduje się zsumowana wartość z danego wiersza.
4. Każdy arkusz zawiera wiersze o nazwach zawartych w pierwszej kolumnie, których położenie moze być różne w zależności jakie składniki wynagrodzenia przysługują danemu pracownikowi.
Makro miałoby:
1. Utworzyć nowy skoroszyt o nazwie np. tabela
2 Utworzyć tabelkę z nazwiskami pracowników (imię i nazwisko to nazwa danego arkusza)
3. W tabeli przy każdym pracowniku w kolumnie o nazwie danego składnika zliczyć wartości z wszystkich miesięcy.
4. składniki wynagrodzenia to
- dopł. za pracę w nocy
- godziny nadliczbowe
- wyrówn. godziny nadliczbowe
- wyrówn. godzin nocnych
5. Jeśli u danego pracownika nie wystąpią te składniki to ma wpisac wartość 0,00
Będę bardzo wdzięczny za takie makro bo bardzo mi ułatwi pracę.
Pozdrawiam
Grzegorz
Poniżej plik
[/u]

Kart płacowe 08-2021-07-2021 przykład.xlsx
Pobierz Plik ściągnięto 7 raz(y) 38.9 KB

ID posta: 420779 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 2828 razy
Posty: 8516
Wysłany: 24-09-2022, 19:24   

Propozycja makra:
Kod:
Sub Generator_Tabeli()
    Dim Nagl(1 To 6) As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks.Add(xlWBATWorksheet).SaveAs Filename:= _
        "Tabela_płace.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
    ActiveSheet.Name = "Tabela"
    Nagl(1) = "Imię i Nazwisko"
    Nagl(2) = "dopł. za pracę w nocy"
    Nagl(3) = "godziny nadliczbowe"
    Nagl(4) = "wyrówn. godziny nadliczbowe"
    Nagl(5) = "wyrówn. godzin nocnych"
    Nagl(6) = "Wartość zmiennych"
    Range("A1:F1").Value = Nagl
    Range("A1:F1").Font.Bold = True
   
    Dim ws, nr As Long, kol As Long, w As Long
    With ThisWorkbook
        nr = 1   ' numer wiersza w tabeli wynikowej
        For Each ws In .Worksheets
            If ws.Name <> "Tabela" Then
                nr = nr + 1
                Cells(nr, "A") = ws.Name
                On Error Resume Next
                For kol = 2 To 5
                    ' w = nr wiersza na karcie płac
                    w = ws.Columns(1).Find(Nagl(kol)).Row
                    If Err = 0 Then
                        Cells(nr, kol).Value = ws.Cells(w, ws.Columns.Count).End(xlToLeft).Value
                    Else
                        Cells(nr, kol).Value = 0
                        Err.Clear
                    End If
                Next kol
                On Error GoTo 0
                Cells(nr, 6).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
            End If
        Next ws
    End With
    With Range("A1").CurrentRegion
        .Borders.LineStyle = xlContinuous
        .Offset(1, 1).Resize(nr - 1, 5).NumberFormatLocal = _
              "# ##0,00_ ;[Czerwony]-# ##0,00\ "
    End With
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub
Utworzony plik ma nazwę "Tabela_płace.xlsx". Jest zapisywany w bieżącym katalogu.

Kart płacowe 08-2021-07-2021 przykład.xlsm
Pobierz Plik ściągnięto 20 raz(y) 49.77 KB

ID posta: 420786 Skopiuj do schowka
 
 
Ptaszko
Forumowicz


Wersja: Win Office 365
Posty: 11
Wysłany: 25-09-2022, 09:25   

Serdecznie dziękuję za pomoc. Makro działa. :clap
ID posta: 420790 Skopiuj do schowka
 
 
Ptaszko
Forumowicz


Wersja: Win Office 365
Posty: 11
Wysłany: 25-09-2022, 09:35   

Maciej Gonet, Bardzo serdecznie dziękuję za pomoc. Makro działa i pomoże mi w pracy. Pozdrawiam Grzegorz
ID posta: 420791 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.wip.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