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
Przesunięty przez: Kaper
09-04-2020, 12:51
Makro grupowania danych wg czasu ich wystąpienia
Autor Wiadomość
boss007 
Fan Excela


Posty: 72
Wysłany: 07-04-2020, 17:18   Makro grupowania danych wg czasu ich wystąpienia

Cześć,
Mam plik z komunikatami które pojawiają o różnych porach dnia i nocy. Chciałbym je podzielić według godzin występowania, tzn. na 3 grupy, z podziałem na takie godziny:
1 grupa: 6:00 - 14:00
2 grupa: 14:00 - 22:00
3 grupa: 22:00 - 6:00

Daty ich wystąpienia nie mają znaczenia,. Czy jest możliwość zrobienie tego makrem? Próbowałem tabelą przestawną, ale albo brakuje mi wiedzy albo w ten sposób się nie da.
Dołączam plik. Z góry dziękuję za wszelkie wskazówki.

Zeszyt 1a.xlsx
Pobierz Plik ściągnięto 10 raz(y) 28.97 KB

ID posta: 385181 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 613 razy
Posty: 3265
Wysłany: 07-04-2020, 18:35   

Nie napisałeś którą godzinę brać pod uwagę - kol. A vs. kol. C. Przyjąłem kol. C.
Testuj.
.

Kopia Zeszyt 1a.xlsm
Pobierz Plik ściągnięto 10 raz(y) 66.13 KB

_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 385187 Skopiuj do schowka
 
 
boss007 
Fan Excela


Posty: 72
Wysłany: 07-04-2020, 19:15   

Faktycznie umknęło mi to. Niestety chodziło o czas z kolumny A. Czy mógłbyś zmienić kod?
Z góry dziękuję.
ID posta: 385194 Skopiuj do schowka
 
 
Kaper 



Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4178 razy
Posty: 7781
Wysłany: 07-04-2020, 19:53   

Ale czy zajrzałeś do tego kodu i spróbowałeś go zrozumieć? Bo jeśli nie, to może temat powinien trafić do zadań, a nie do "mam problem z makrem"?

No dobra, zostawmy dydaktykę.

do tej pory w kodzie było wybieranie z czwartej kolumny (nie C tylko D :-) ) zawierającej same czasy.
Kod:
    t = Cells(i, 4).Value

A skoro na podstawie kolumny A, to trzeba sprawdzać część opisującą czas z pierwszej kolumny (nie całą wartość, tylko wartość z odjętą datą):
Kod:
    t = Cells(i, 1).Value - Int(Cells(i, 1).Value)


I w nawiązaniu do innego postu z dziś: http://www.excelforum.pl/...7773.htm#385196 pewnie warto pomyśleć o jakiejś optymalizacji kodu (bo ten jest przejrzysty ale nie będzie zbyt szybki) np. wykorzystaniu wbudowanego mechanizmu filtrowania. Jeśli daty są z jednej doby, to bez dodatkowych sztuczek, jeśli z kilku - dodać kolumnę z godzinami, flirtować i kopiować, usunąć kolumnę z godzinami. Ale to tylko taka koncepcja.
_________________
Kaper Jej Królewskiej Mości :boss

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


Wersja: Win Office 2010
Pomógł: 1366 razy
Posty: 3944
Wysłany: 07-04-2020, 20:05   

To dołoźe trochę szybszy kod.
Wyniki są w tym samym arkuszu co dane.
Pierwszy zakres od G3, drugi do L3, a trzeci (22:00-06:00) od Q3.
Sformatuj kolumny wyników z datami tak jak w danych.
Do modułu normalnego VBA (Alt+11 --> Insert --> Module) skopiuj poniższy kod i uruchom.
Kod:
Sub Przedzialy()
    Dim a(), ag1, ag2, ag3, ms
    Dim i As Long, g1 As Long, g2 As Long, g3 As Long
    Dim gr1, gr2, gr3
   
   
    gr1 = "06:00-14:00"
    gr2 = "14:00-22:00"
    gr3 = "22:00-06:00"
    a = [A3].CurrentRegion.Value
    ag1 = Application.Transpose(Evaluate("Row(1:" & UBound(a) & ")"))
    ag2 = ag1
    ag3 = ag1
    For i = 1 To UBound(a)
        ms = a(i, 1) - Int(a(i, 1))
        If ms >= CDate(Split(gr1, "-")(0)) And ms <= CDate(Split(gr1, "-")(1)) Then
            g1 = g1 + 1
            ag1(g1) = i
         ElseIf ms >= CDate(Split(gr2, "-")(0)) And ms <= CDate(Split(gr2, "-")(1)) Then
            g2 = g2 + 1
            ag2(g2) = i
        Else
            g3 = g3 + 1
            ag3(g3) = i
        End If
    Next
    ReDim Preserve ag1(1 To g1)
    ReDim Preserve ag2(1 To g2)
    ReDim Preserve ag3(1 To g3)
    Application.ScreenUpdating = False
    Range("G3:T3000").ClearContents
    Range("g3").Resize(g1, 4) = Application.Index(a, Application.Transpose(ag1), Array(1, 2, 3, 4))
    [L3].Resize(g2, 4) = Application.Index(a, Application.Transpose(ag2), Array(1, 2, 3, 4))
    [Q3].Resize(g3, 4) = Application.Index(a, Application.Transpose(ag3), Array(1, 2, 3, 4))
End Sub
_________________
Pozdrawiam.
ID posta: 385199 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 613 razy
Posty: 3265
Wysłany: 07-04-2020, 20:38   

Proszsz...

Ponieważ kod faktycznie jest "mało wyszukany" i przez to wolny - dołożyłem pasek postępu (jeszcze bardziej spowalnia ale przynajmniej widać że pracuje... :mrgreen: ).
.

Kopia Zeszyt 1a.xlsm
Pobierz Plik ściągnięto 9 raz(y) 76.04 KB

_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 385201 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 268 razy
Posty: 1285
Wysłany: 08-04-2020, 00:07   

...
Kod:
Option Explicit

Const ark = "Arkusz1"   'Nazwa arkusza
Const pocz = "A3"       'Początek tabelki

Const gr1 = (6 / 24)    '1 grupa: 6:00 - 13:59
Const gr2 = (14 / 24)   '2 grupa: 14:00 - 21:59
Const gr3 = (22 / 24)   '3 grupa: 22:00 - 5:59

Sub a_grupiszczak()
    Dim kol%, i&, idx&, godz, tbl
   
    With ThisWorkbook.Sheets(ark)
        kol = .Range(pocz).CurrentRegion.Columns.Count + 1
        tbl = .Range(pocz & ":" & Left(pocz, 1) & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
   
    idx = UBound(tbl, 1)
   
    On Error Resume Next
        For i = 1 To idx
            godz = CInt(Split(Split(tbl(i, 1), Chr(32), -1, 1)(1), ":", -1, 1)(0)) / 24
            If Err.Number = 0 Then
                If godz >= gr1 And godz < gr2 Then
                    tbl(i, 1) = "Gr01"
                ElseIf godz >= gr2 And godz < gr3 Then
                    tbl(i, 1) = "Gr02"
                ElseIf (godz >= gr3 And godz < 1) Or (godz >= 0 And godz < gr1) Then '... :)
                    tbl(i, 1) = "Gr03"
                Else
                    tbl(i, 1) = "Grupa ABC"
                End If
            End If
            Err.Clear
        Next
    On Error GoTo 0
   
    With ThisWorkbook.Sheets(ark)
        .Cells(3, kol).Resize(idx, 1).Value = tbl: tbl = Empty
    End With
End Sub

...
ID posta: 385206 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