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: 70050 Skopiuj do schowka Wyciąganie czasu z ciągu znaków oraz liczenie różnic
Autor Wiadomość
stingtanner
ExcelGaduła 500+


Wersja: Win Office 2013
Pomógł: 6 razy
Posty: 511
Wysłany: 04-02-2021, 08:13   Wyciąganie czasu z ciągu znaków oraz liczenie różnic

Witajcie

W załączniku przygotowałem wierna kopię oryginału oraz poprawne wyniki jakie chciał bym osiągnąć.

W kol E są czasy.
Kolorami zaznaczyłem kilka, aby poprawnie wytłumaczyć o co mi chodzi.

Komórka E14 ma zaznaczoną godzinę 16:12, następnie w E15 na czerwono jest 16:14 tzn. że różnica wynosi 2 min.

Następnie w E15 na niebiesko jest 20:15, a w E16 20:17. Różnica 2 min.
Różnice trafiają do kolumny O.
Następnie jeśli są (jak w tym pierwszym przypadku) tylko 2 wyniki, to suma jest = 4

Jak już zauważyliście czasy, na których różnicy mi zależy, są po przekątnej.

Dodam że zakresy są dynamiczne.

Jeśli ktoś z was ma pomysł jak rozwiązać ten problem, będę wdzięczny za pomoc.

Liczenie test.xlsm
Pobierz Plik ściągnięto 9 raz(y) 17.02 KB

ID posta: 399703 Skopiuj do schowka
 
 
J_B 
Excel Expert


Wersja: Win Office 2016
Pomógł: 541 razy
Posty: 1339
Wysłany: 04-02-2021, 09:54   

stingtanner napisał/a:
będę wdzięczny za pomoc.

Samo wyliczanie nie stanowi problemu
Kod:
Sub WyliczCzas()
    Dim W, Z
    W = Split(ActiveCell.Value, " ")
    Z = Split(ActiveCell.Offset(1, 0).Value, " ")
    Debug.Print DateDiff("n", CDate(W(2)), CDate(Z(1)))
End Sub

Pytanie może dotyczyć rozmieszczenia i układu bloków
1 Czy zawsze będą rozdzielone "8"
2 Czy po "8" mogą i ile bywa pustych wierszy
3 Czy zawsze będą dopasowane parami ( nie będzie danych bez pary)
4 Co oznacza ostatni blok danych 21:56 04:47 6,85
12,52
12,52
Pytam po to żeby niepotrzebnie nie sprawdzać kodem co tam w kolejnych wierszach może napotkać kod
Janusz
ID posta: 399709 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1443 razy
Posty: 4113
Wysłany: 04-02-2021, 10:07   

Może to będzie dobrze.
Kod:
Sub czas_kuma()
    Dim a(), tm, v
    Dim i As Integer, suma As Integer, ssuma As Integer
    Dim ms As String
   
    With Tabelle1
        a = .[e10].Resize(.UsedRange.Rows.Count - 2, 11).Value
        For i = 1 To UBound(a)
            ms = Trim(a(i, 1))
            If UBound(Split(ms, ":")) > 0 Then
                v = Split(ms, " ")
                If IsEmpty(tm) Then
                    tm = TimeValue(v(1))
                Else
                    a(i - 1, 11) = Round(24 * 60 * (TimeValue(v(0)) - tm))
                    suma = suma + a(i - 1, 11)
                    tm = TimeValue(v(1))
                End If
            Else
                If suma > 0 Then
                    a(i - 1, 10) = "Suma": a(i - 1, 11) = suma
                    ssuma = ssuma + suma
                    suma = 0
                End If
                tm = Empty
            End If
        Next
        .[n10].Resize(UBound(a), 2) = Application.Index(a, Evaluate("row(1:" & UBound(a) & ")"), Array(10, 11))
        .[q14].Resize(, 2).Value = Array("Suma", ssuma)
    End With
End Sub


Liczenie test_kuma.xlsm
Pobierz Plik ściągnięto 5 raz(y) 20.76 KB

_________________
Pozdrawiam.
ID posta: 399712 Skopiuj do schowka
 
 
stingtanner
ExcelGaduła 500+


Wersja: Win Office 2013
Pomógł: 6 razy
Posty: 511
Wysłany: 04-02-2021, 11:43   

Dzięki za odpowiedź

J_B,
1. Nie zawsze
2. Mogą być, ale ciężko stwierdzić ile bo to SAP generuje dokument.
3. Może być tylko 1 wpis, bez pary która trzeba wyliczyć. Takie coś pomijamy
4. Jest to wpis bez pary.
A te 12,52 to już jakieś śmieci generowane przez SAP, nie potrzebne mi.

kuma,
W załączniku wygenerowałem 2 dodatkowe przykłady.
Zerknij proszę dlaczego w tabelle3 wywala błąd.
Dla tabelle1 i 2 działa idealnie.

Już widzę że SAP generuje sobie w różny sposób.
Będę musiał później wziąć pod uwagę, ewentualną korektę, aby dostosować się do macro.

Edit.
Analizuję teraz i widzę, że nie wziąłem pod uwagę przełomu dnia.
Błąd chyba wywala gdy jest godzina 24:00 i dalej, lub gdy ma policzyć między np. 23:58 a 00:01.

Liczenie test_kuma.xlsm
Pobierz Plik ściągnięto 8 raz(y) 29.76 KB

ID posta: 399727 Skopiuj do schowka
 
 
stingtanner
ExcelGaduła 500+


Wersja: Win Office 2013
Pomógł: 6 razy
Posty: 511
Wysłany: 04-02-2021, 14:17   

Udało mi się trochę poprawić ten błąd, ale nadal liczy źle.
Mianowicie w tabelle3 jest czas 23:58 <-> 00:01 (pierwsza linia czasów), zamiast policzyć 3 liczy 1, nie wiem dla dlaczego.

Kod:
Sub czas_kuma()
    Dim a(), tm, v
    Dim i As Integer, suma As Integer, ssuma As Integer
    Dim ms As String
   
    With Tabelle1
        a = .[e10].Resize(.UsedRange.Rows.Count - 2, 11).Value
        For i = 1 To UBound(a)
            ms = Trim(a(i, 1))
            If UBound(Split(ms, ":")) > 0 Then
                v = Split(ms, " ")
                If IsEmpty(tm) Then
                    tm = TimeValue(v(1))
                Else
                    'a(i - 1, 11) = Round(24 * 60 * (TimeValue(v(0)) - tm))
                    'MODYFIKACJA
                    If TimeValue(v(0)) > tm Then
                        a(i - 1, 11) = Round(24 * 60 * (TimeValue(v(0)) - tm))
                    Else
                        a(i - 1, 11) = Round(24 * 60 * (1 - (TimeValue(v(0)) + tm)))
                    End If
                    'MODYFIKACJA KONIEC
                    suma = suma + a(i - 1, 11)
                    tm = TimeValue(v(1))
                End If
            Else
                If suma > 0 Then
                    a(i - 1, 10) = "Suma": a(i - 1, 11) = suma
                    ssuma = ssuma + suma
                    suma = 0
                End If
                tm = Empty
            End If
        Next
        .[n10].Resize(UBound(a), 2) = Application.Index(a, Evaluate("row(1:" & UBound(a) & ")"), Array(10, 11))
        .[q14].Resize(, 2).Value = Array("Suma", ssuma)
    End With
End Sub
ID posta: 399738 Skopiuj do schowka
 
 
stingtanner
ExcelGaduła 500+


Wersja: Win Office 2013
Pomógł: 6 razy
Posty: 511
Wysłany: 04-02-2021, 14:59   

Chyba się udało, aczkolwiek nie mam pewności czy na innych przykładach takie rozwiązanie zadziała zgodnie z planem.

Kod:
If TimeValue(v(0)) > tm Then
     a(i - 1, 11) = Round(24 * 60 * (TimeValue(v(0)) - tm))
Else
     a(i - 1, 11) = Round(24 * 60 * (TimeValue(v(0)) + tm)) + Round(24 * 60 * (TimeValue(v(0)) - tm))
End If


Edit.
Jednak za szybko się cieszyłem ;/ zamiast 3 pokazuje 2 ;/
ID posta: 399740 Skopiuj do schowka
 
 
J_B 
Excel Expert


Wersja: Win Office 2016
Pomógł: 541 razy
Posty: 1339
Wysłany: 04-02-2021, 15:52   

Problem jest gdy napotka wpis " 21:49 24:02 2,22" czyli godz 24 to zamieniam na "00:00"
Lecz jak już jest " 28:13 30:03 1,83" to pomijam bo takich godzin doby nie mamy
Takie wpisy masz w arkuszu "Tabelle3"
Patrz załącznik może spełni Twoje oczekiwania
Janusz

Liczenie test(1).xlsm
Pobierz Plik ściągnięto 2 raz(y) 23.97 KB

ID posta: 399742 Skopiuj do schowka
 
 
stingtanner
ExcelGaduła 500+


Wersja: Win Office 2013
Pomógł: 6 razy
Posty: 511
Wysłany: 04-02-2021, 17:03   

J_B,
Dzięki przetestuję na większej grupie danych.
ID posta: 399752 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1443 razy
Posty: 4113
Wysłany: 04-02-2021, 19:14   

Wydaje mi się, że teraz powinno zadziałać również na Tabelle3.
Kod:
Sub czas_kuma_2()
    Dim a(), tm, v, v_1, v_0
    Dim i As Integer, suma As Integer, ssuma As Integer
    Dim ms As String

    With Tabelle3       '<--- to jest nazwa kodowa arkusza, nie nazwa zakładkowa
                               ' zwróć uwagę na te nazwy, gdy będziesz dokładał, kopiował arkusze
                               'zajrzyj do VBAProject w module VBA - nazwy arkuszowe są w nawiasach.
        a = .[e10].Resize(.UsedRange.Rows.Count - 2, 11).Value
       
        For i = 1 To UBound(a)
            ms = Trim(a(i, 1))
            If UBound(Split(ms, ":")) > 0 Then
                v = Split(ms, " ")
                If v(1) >= "24:00" Then
                    v_1 = TimeValue("00:" & Right(v(1), 2)) + 1
                Else
                    v_1 = TimeValue(v(1))
                End If
                If v(0) >= "24:00" Then
                    v_0 = TimeValue("00:" & Right(v(0), 2)) + 1
                Else
                    v_0 = TimeValue(v(0))
                End If
                If IsEmpty(tm) Then
                    tm = v_1
                Else
                    If v_0 < tm Then v_0 = v_0 + 1
                    a(i - 1, 11) = Round(24 * 60 * (v_0 - tm))
                    suma = suma + a(i - 1, 11)
                    tm = v_1
                End If
            Else
                If suma > 0 Then
                    a(i - 1, 10) = "Suma": a(i - 1, 11) = suma
                    ssuma = ssuma + suma
                    suma = 0
                End If
                tm = Empty
            End If
        Next
        .[n10].Resize(UBound(a), 2) = Application.Index(a, Evaluate("row(1:" & UBound(a) & ")"), Array(10, 11))
        .[q14].Resize(, 2).Value = Array("Suma", ssuma)
    End With
End Sub
_________________
Pozdrawiam.
ID posta: 399760 Skopiuj do schowka
 
 
stingtanner
ExcelGaduła 500+


Wersja: Win Office 2013
Pomógł: 6 razy
Posty: 511
Wysłany: 08-02-2021, 08:43   

kuma,
Dzięki już wygląda to dobrze.
ID posta: 399946 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