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: 67701 Skopiuj do schowka scalanie danych--- ponad 0 tys rekordów
Autor Wiadomość
ESO
świeżak


Wersja: Win Office 2016
Posty: 9
Wysłany: 01-04-2020, 11:16   scalanie danych--- ponad 0 tys rekordów

Witam wszystkich :)

potrzebuję pomocy. Mam plik zawierający ponad 50 tys rekordów.
Muszę scalić dane po datach. Tzn. Mam nr pracownika, nazwę stanowiska i okresy od i do.
W ramach jednego pracownika to samo stanowisko może być rozbite na kilka okresów.
Jak mogę najszybciej to scalić . Jak napisać kodzik dla PQ ? Jest jakiś inna prosta alternatywa.
Przyznam, że nie jestem "orłem" w Excel.

Przykład stanowiska.xlsx
Pobierz Plik ściągnięto 19 raz(y) 14.44 KB

ID posta: 384658 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1367 razy
Posty: 3945
Wysłany: 01-04-2020, 19:02   

U mnie kodem VBA. Może inni w PQ.
Wyniki będą w osobnym arkuszu o nazwie 'Arkusz2'.
Przed uruchomieniem kodu usuń dane z 'Arkusza1', które pokazują jak powinny wyglądać końcowe wyniki.
Kod:
Sub Scalanie()
    Dim a(), af
    Dim i As Long, ii As Long
    Dim j As Integer, cl As Integer, cls As Integer
    Dim ms As String
   
    Sheets("Arkusz2").UsedRange.ClearContents
    With Sheets("Arkusz1").[A1].CurrentRegion
        If .Rows.Count > 1 Then
            a = .Value
            cls = UBound(a, 2)
            ReDim af(1 To UBound(a), 1 To UBound(a, 2))
            With VBA.CreateObject("Scripting.Dictionary")   'd
                For i = 1 To UBound(a)
                    ms = a(i, 1) & a(i, 2) & a(i, 3)
                    If Not .exists(ms) Then
                        ii = ii + 1
                        .Item(ms) = ii
                        For j = 1 To cls
                            af(ii, j) = a(i, j)
                        Next
                    Else
                        cl = .Item(ms)
                        For j = 3 To cls
                            Select Case j
                                Case 3, 4
                                    If Len(af(cl, j)) = 0 Then af(cl, j) = a(i, j)
                                Case 5, 6
                                    If a(i, j) < af(cl, j) Then af(cl, j) = a(i, j)
                            End Select
                        Next
                    End If
                Next   'i
            End With
        End If
    End With
    With Sheets("Arkusz2")
        .[A1].Resize(ii, UBound(af, 2)) = af
    End With
End Sub
_________________
Pozdrawiam.
ID posta: 384703 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 614 razy
Posty: 3271
Wysłany: 01-04-2020, 19:13   

@Autor: Policz czas.
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 384706 Skopiuj do schowka
 
 
ESO
świeżak


Wersja: Win Office 2016
Posty: 9
Wysłany: 02-04-2020, 07:50   

Bardzo dziękuję za pomoc. W pliku jednak pojawiają się nieścisłości.
W sytuacji gdy jest pracownik ma dwa a nawet więcej rekordów z tym samym stanowiskiem- makro nie scala tego okresu.
W załączeniu przykład.

Nieprawidłowosci.xlsx
Pobierz Plik ściągnięto 9 raz(y) 10.2 KB

ID posta: 384741 Skopiuj do schowka
 
 
Waldek 
Excel Expert


Wersja: Win Office 2019
Pomógł: 238 razy
Posty: 1051
Wysłany: 02-04-2020, 23:06   

Mam kilka pytań. Czy numery ID są jedne pod drugim bez pustych komórek? Jeżeli tak to uprości makro. Czy rozwiązanie może być w drugim arkuszu? Czy dla jednego pracownika i tego samego stanowiska występują dziury w okresach czasu? Np. od 10.01.2020 do 15.01.2020 i od 30.01.2020 do 31.01.2020. Jeżeli tak to czy scalać takie okresy od 10.01.2020 do 31.01.2020 czy nie?
ID posta: 384814 Skopiuj do schowka
 
 
ESO
świeżak


Wersja: Win Office 2016
Posty: 9
Wysłany: 03-04-2020, 07:07   

W nr ID nie ma luk- jest zachowana ciągłość. Tak zdarzają się, wynika to ze zmiany stanowiska tylko na np. 3 miesiące albo i dłużej/krócej- i ponowny powrót do poprzedniego stanowiska. W tej sytuacji stanowiska powinny być pokazane oddzielnie.
ID posta: 384821 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1367 razy
Posty: 3945
Wysłany: 03-04-2020, 08:09   

Może to był Prima Aprilisowy żart? :-D
Powinno być.
Kod:
Sub Scalanie()
    Dim a(), af
    Dim i As Long, ii As Long
    Dim j As Integer, rw As Integer, cls As Integer
    Dim ms As String
   
    Sheets("Arkusz2").UsedRange.ClearContents
    With Sheets("Arkusz1").[A1].CurrentRegion
        If .Rows.Count > 1 Then
            a = .Value
            cls = UBound(a, 2)
            ReDim af(1 To UBound(a), 1 To UBound(a, 2))
            With VBA.CreateObject("Scripting.Dictionary")   'd
                For i = 1 To UBound(a)
                    ms = a(i, 1) & a(i, 2) & a(i, 3)
                    If Not .exists(ms) Then
                        ii = ii + 1
                        .Item(ms) = ii
                        For j = 1 To cls
                            af(ii, j) = a(i, j)
                        Next
                    Else
                        rw = .Item(ms)
                        For j = 4 To cls
                            Select Case j
                                Case 4
                                    If Len(af(rw, j)) = 0 Then af(rw, j) = a(i, j)
                                Case 5
                                    If a(i, j) < af(rw, j) Then af(rw, j) = a(i, j)
                                Case 6
                                    If a(i, j) > af(rw, j) Then af(rw, j) = a(i, j)
                            End Select
                        Next
                    End If
                Next   'i
            End With
        End If
    End With
    With Sheets("Arkusz2")
        .[A1].Resize(ii, UBound(af, 2)) = af
    End With
End Sub
_________________
Pozdrawiam.
ID posta: 384822 Skopiuj do schowka
 
 
ESO
świeżak


Wersja: Win Office 2016
Posty: 9
Wysłany: 03-04-2020, 13:24   

:-D W końcu data zobowiązuje :lol:
Bardzo dziękuję za pomoc - zabieram się za obróbkę pliku- zobaczymy jak zadziała :)
ID posta: 384854 Skopiuj do schowka
 
 
Bill Szysz 
Excel Expert


Wersja: Win Office 365
Pomógł: 880 razy
Posty: 3556
Wysłany: 03-04-2020, 14:42   

No to w PQ jeszcze (choć wyniki mam inne niż przy zastosowaniu makra kumy)
Albo ja coś źle zrozumiałem albo on :mrgreen:
Zapytanie m.in. bierze pod uwagę nazwę polską (bez angielskiej) przy grupowaniu.
Grupowanie odbywa się na zasadach lokalnych a nie ogólnych (ostatni argument Table.Group).

Przykład stanowiska_PQ_BS.xlsx
Pobierz Plik ściągnięto 6 raz(y) 26.06 KB

_________________
Zlecenia, konsultacje, doradztwo i szkolenia z Power Query, Power BI i Excela - Raporty, Analizy, Projekty
Pozdrawiam, były szbill62 aktualnie Bill Szysz
ID posta: 384866 Skopiuj do schowka
 
 
ESO
świeżak


Wersja: Win Office 2016
Posty: 9
Wysłany: 06-04-2020, 16:35   

Bill Szysz i Kuma- bardzo Wam dziękuję za pomoc. Stworzone przez Was narzędzia okazały się bardzo pomocne. :-) :-) :-)
Dużo zdrówka ! :mrgreen:
ID posta: 385070 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