Hozzászólások
-
SzerzőBejegyzés
-
Köszönöm szépen a választ, közben már összedobtam egy másik kódot, ahol már nem használtam GoTo-t kiszerveztem külön szubrutinokba.
Így már működik!
Köszönöm mindenkinek a segítséget!
Sub PkAl() ' ' Makró1 Makró ' ' Billentyűparancs: Ctrl+l ' Dim x As Integer Dim tol, ig As Variant Dim a, b, c, d, e As Variant x = 0 a = "06:00" '0,25 b = "07:30" '0,3125 c = "13:30" '0,5625 d = "16:00" '0,666666666666667 e = "22:00" '0,916666666666667 f = "23:59" '0,999305555555556 g = "00:01" '0,000694444444444444 Cells(1, 7) = "munkaidőn belül" 'kiírja az célértékek kategóriáit Cells(1, 8) = "munkaidőn túl" Cells(1, 9) = "munkanap éjszaka" Cells(1, 10) = "hétvége nappal" Cells(1, 11) = "hétvége éjszaka" Cells(2, 7) = 0 Cells(2, 8) = 0 Cells(2, 9) = 0 Cells(2, 10) = 0 Cells(2, 11) = 0 Do x = x + 5 ig = Right(Cells(x, 1), 5) tol = Left(Cells(x, 1), 5) If Cells(x - 1, 1).Value = "hétfő" Then Call hétköznap(tol, ig, a, b, c, d, e, f, g) ElseIf Cells(x - 1, 1).Value = "kedd" Then Call hétköznap(tol, ig, a, b, c, d, e, f, g) ElseIf Cells(x - 1, 1).Value = "szerda" Then Call hétköznap(tol, ig, a, b, c, d, e, f, g) ElseIf Cells(x - 1, 1).Value = "csütörtök" Then Call hétköznap(tol, ig, a, b, c, d, e, f, g) ElseIf Cells(x - 1, 1).Value = "péntek" Then Call péntek(tol, ig, a, b, c, d, e, f, g) ElseIf Cells(x - 1, 1).Value = "szombat" Then Call hétvége(tol, ig, a, b, c, d, e, f, g) ElseIf Cells(x - 1, 1).Value = "vasárnap" Then Call hétvége(tol, ig, a, b, c, d, e, f, g) End If Loop Until IsEmpty(Cells(x + 5, 1)) End Sub Sub hétköznap(tol, ig, a, b, c, d, e, f, g) 'hétköznap: If tol > e And tol < f Or ig > e And ig < f Then Cells(2, 9) = Cells(2, 9) + 1 'munkanap éjszaka ElseIf tol > g And tol < a Or ig > g And ig < a Then Cells(2, 9) = Cells(2, 9) + 1 'munkanap éjszaka ElseIf tol > d And tol < e Or ig > d And ig < e Then Cells(2, 8) = Cells(2, 8) + 1 'munkaidőn túli ElseIf tol > a And tol < b Or ig > a And ig < b Then Cells(2, 8) = Cells(2, 8) + 1 'munkaidőn túli ElseIf tol >= b And tol <= d And ig >= b And ig <= d Then Cells(2, 7) = Cells(2, 7) + 1 'munkaidőn belül End If End Sub Sub péntek(tol, ig, a, b, c, d, e, f, g) 'péntek: If tol > e And tol < f Or ig > e And ig < f Then Cells(2, 9) = Cells(2, 9) + 1 'munkanap éjszaka ElseIf tol > g And tol < a Or ig > g And ig < a Then Cells(2, 9) = Cells(2, 9) + 1 'munkanap éjszaka ElseIf tol > a And tol < b Or ig > a And ig < b Then Cells(2, 8) = Cells(2, 8) + 1 'munkaidőn túli ElseIf tol > c And tol < e Or ig > c And ig < e Then Cells(2, 8) = Cells(2, 8) + 1 'munkaidőn túli ElseIf tol >= b And tol <= d And ig >= b And ig <= d Then Cells(2, 7) = Cells(2, 7) + 1 'munkaidőn belül End If End Sub Sub hétvége(tol, ig, a, b, c, d, e, f, g) 'hétvége: If tol > e And tol < f Or ig > e And ig < f Then Cells(2, 11) = Cells(2, 11) + 1 'hétvége éjszaka ElseIf tol > g And tol < a Or ig > g And ig < a Then Cells(2, 11) = Cells(2, 11) + 1 'hétvége éjszaka ElseIf tol >= a And tol <= e And ig >= a And ig <= e Then Cells(2, 10) = Cells(2, 10) + 1 'hétvége nappal End If End SubKöszönöm szépen az útmutatást, akkor a PowerQuery irányba fogok nézelődni. A feladatban még az a szép, hogy a 07:30-16:00 idősávot vehetjük bázisidőnek, mert ha lefelé, vagy felfelé kilóg belőle akkor már a másik idősávba kellene számolni.
szerk:
Közben elkezdtem VBA-val makrózni, idáig jutottam:Sub Makró1() ' ' Makró1 Makró ' ' Billentyűparancs: Ctrl+l ' Dim x As Integer Dim a As Integer Dim b As Integer Dim c As Integer Dim d As Integer Dim e As Integer hétköznap: If Cells(x, 4) > "07:30" And Cells(x, 4) < "16:00" Then GoTo tali If Cells(x, 4) > "16:00" And Cells(x, 4) < "22:00" Then GoTo túli If Cells(x, 4) > "06" And Cells(x, 4) < "07:30" Then GoTo túli If Cells(x, 4) > "22:00" And Cells(x, 4) < "06:00" Then GoTo mnéjszaka péntek: If Cells(x, 4) > "07:30" And Cells(x, 4) < "13:30" Then GoTo tali If Cells(x, 4) > "13:30" And Cells(x, 4) < "22:00" Then GoTo túli If Cells(x, 4) > "06" And Cells(x, 4) < "07:30" Then GoTo túli If Cells(x, 4) > "22:00" And Cells(x, 4) < "06:00" Then GoTo mnéjszaka hétvége: If Cells(x, 4) > "06:00" And Cells(x, 4) < "22:00" Then GoTo msznappal If Cells(x, 4) > "22:00" And Cells(x, 4) < "06:00" Then GoTo mszéjszaka tali: Cells(2, 7) = a + 1 túli: Cells(2, 8) = b + 1 mnéjszaka: Cells(2, 9) = c + 1 msznappal: Cells(2, 10) = d + 1 mszéjszaka: Cells(2, 11) = e + 1 Cells(1, 7) = "tali" Cells(1, 8) = "túli" Cells(1, 9) = "mnkanap éjszaka" Cells(1, 10) = "hétvége nappal" Cells(1, 11) = "hétvége éjszaka" x = 0 a = 0 b = 0 c = 0 d = 0 e = 0 Do ' átrakja az időintervallumokat a D és E oszlopba x = x + 5 Cells(x, 4) = Left(Cells(x, 1), 5) Cells(x, 5) = Right(Cells(x, 1), 5) Loop Until IsEmpty(Cells(x + 5, 1)) x = 0 Do x = x + 5 If Cells(x - 1, 1) = "hétfő" Then GoTo hétköznap If Cells(x - 1, 1) = "kedd" Then GoTo hétköznap If Cells(x - 1, 1) = "szerda" Then GoTo hétköznap If Cells(x - 1, 1) = "csütörtök" Then GoTo hétköznap If Cells(x - 1, 1) = "péntek" Then GoTo péntek If Cells(x - 1, 1) = "szombat" Then GoTo hétvége If Cells(x - 1, 1) = "vasárnap" Then GoTo hétvége Loop Until IsEmpty(Cells(x + 5, 1)) End SubCsakhát nem akar működni!
Mi lehet a hiba?Szia Imi!
Köszönöm szépen a gyors választ. Kezdem a rosz hírrel. Csak Office 2016 van. A manuális munkát szeretném kiváltani, mert minden hónapban sok ilyen adatforrás van word-ben és csak így lehet adatot kinyerni belőlük excelbe. Az „előírt terv alapján” és az, hogy „nem” irrelevánsak. A PowerQuerry nekem is eszembe jutott, de ahhoz méginkább láma vagyok mint az excelhez. Bár gyorsan tanulok.
Ha az időintervallumból esetleg átlóg egy következő kategóriába, akkor már oda kellene elkönyvelni, mint eredményt. Sajnos az időintervallumok kötjelesen vannak. Nem tudom van-e rá esetleg valami script lehetőség, ami a szöveget elemzi és utána összehasonlítja az eredményt a cél intervallummal. Valami szubrutinokkal (nagyon régen programoztam). -
SzerzőBejegyzés
