MAKRO EXCEL - Prosím o pomoc.

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

majerpetr
nováček
Příspěvky: 2
Registrován: listopad 18
Bydliště: Hradec Králové
Pohlaví: Muž
Stav:
Offline
Kontakt:

MAKRO EXCEL - Prosím o pomoc.

Příspěvekod majerpetr » 09 lis 2018 09:54

Dobrý den,

Potřeboval bych pomoct s makrem ve VBA v Excelu. Dostal jsem to jako zadanou práci a v pondělí 12.11.2018 mám toto makro předvést. Učím se VBA svépomocí celkem na rychlo a moc to nedávám. Prosím Vás tedy tímto o pomoc. Snad bude někdo tak hodný a pomůže mě s tím makrem. Odměna ho jistě nemine !!! :-) :-)

Zadání:
Mám několik souborů ve formátu XLS. Ukázka ve složce „data“. V přiloženém odkazu: http://leteckaposta.cz/771890990.Tyto soubory jsou vždy ve shodném formátu. Data jsou vždy na prvním listě. Ostatní listy jsou vždy prázdné.
sloupec A = časová řada (datum)
sloupec B = naměřené hodnoty
sloupec C = status
- S tím že časová řada je vždy na začátku každého souboru ve sloupci A. Nemusí být vždy stejná (nemusí tam být vždycky časová řada pro jeden měsíc) – může být delší i kratší časový interval.
- Dále se potom naměřené hodnoty a status střídavě opakují až do konce. (počet těchto řádků a sloupců s naměřenými daty a statusem můžou být různá – v závislostech na délce časové řady a počtu elektroměrů.
Makro by mělo naimportovat všechny první listy ze všech souborů, které jsou ve složce (v tomto případě 4 soubory: „1“,“2“,“3“,“4“) – může jich být i více i méně. Data jsou vždy na prvním listě v souboru, ostatní listy jsou vždy prázdné a mohou se smazat.

Tohle makro již mám(snad), viz níže, mělo by fungovat. Je tam sice natvrdo nastavená cesta odkud se soubory importují, což není ta nejlepší varianta. Pokud by tedy šlo cestu k souborům vybrat ručně a poté spustit makro bylo by to lepší a jednodušší. Ale i tato varianta se dá ale přežít, jelikož soubory stahuji a importuji pořád ze stejného adresáře.

Makro je i v odkazu, jedná se o soubor: NACTI VÍCE SEŠITŮ DO JEDNOHO.XLSM

Sub GetSheets()
Path = "C:\Users\petrm\Desktop\Nová složka (2)\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
'smazání prázdných listů
Dim SH As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each SH In Worksheets
If Application.WorksheetFunction.CountA(SH.Cells) = 0 Then SH.Delete
Next SH
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Další krok:
Poté co jsem si makrem výše naimportoval ze složky všechny listy ze sešitů do jednoho sešitu a odmazal ty prázdné listy, mě zbyli v jednom sešitě čtyři listy s daty. Dále bych nad těmito listy, které mají data, potřeboval udělat kontrolu.

Tento kód funguje jako kontrola, ale pouze zatím jen nad jedním listem. Můžete vyzkoušet, také v odkazu, který jsem poslal výše, jedná se o soubor: MAKRO KONTROLA.XLSM . Nevím jak udělat to, aby makro bralo více listů a ukládalo je např. na jeden list pod sebe.

Option Explicit
Dim tdd_dira As New Collection
Dim tdd_bez_dat As New Collection

Sub najdi_diry()
Dim pocet_radku, pocet_sloupcu
Dim oblast As Range
Dim zahlavi As Range
Dim b As Range
Dim t_start
Dim dira As Boolean
Dim dira_asi As Boolean
Dim bez_dat As Boolean
Dim i As Long
Dim tdd_celkem, tdd_spatne, tdd_bez_dat_spatne

t_start = Timer
data.Activate
output.Cells.ClearContents
Set tdd_dira = Nothing
Set tdd_bez_dat = Nothing
pocet_radku = Range("A1048576").End(xlUp).Row
pocet_sloupcu = Range("XFD1").End(xlToLeft).Column
Debug.Print "radku: " & pocet_radku, "sloupcu: " & pocet_sloupcu

Set zahlavi = [A1]
While zahlavi <> ""
If zahlavi = "Status" Then
Set oblast = Range(zahlavi.Offset(1, 0), zahlavi.Offset(pocet_radku - 1)) 'Debug.Print "oblast", oblast.Address
tdd_celkem = tdd_celkem + 1
bez_dat = True
dira = False
For Each b In oblast
'jsou vsechny hodnoty bez dat?
'If b <> "neznámá hodnota" Then bez_dat = False
If b <> "" Then bez_dat = False
If b = "" And b.Offset(1, 0) = "neznámá hodnota" Then
dira = True
Exit For
End If
If b = "" And b.Offset(-1, 0) = "neznámá hodnota" Then
dira = True
'Exit For
End If
Next
'tdd s dirou
If dira Then
tdd_dira.Add (zahlavi.Offset(0, -1))
tdd_spatne = tdd_spatne + 1
End If
'tdd bez dat
If bez_dat Then
tdd_bez_dat.Add (zahlavi.Offset(0, -1))
tdd_bez_dat_spatne = tdd_bez_dat_spatne + 1
End If
End If
Set zahlavi = zahlavi.Offset(0, 1)
Wend
'vypis tdd s dirou
output.Cells(1, 1) = "TDD od kdy do kdy: "
For i = 1 To tdd_dira.Count
output.Cells(i + 1, 1) = tdd_dira(i)
Next
'vypis tdd bez dat
output.Cells(1, 2) = "TDD bez dat celý měsíc"
For i = 1 To tdd_bez_dat.Count
output.Cells(i + 1, 2) = tdd_bez_dat(i)
Next
output.Cells(1, 3) = "tdd celkem: " & tdd_celkem
output.Cells(1, 4) = "tdd spatne: " & tdd_spatne
output.Cells(1, 5) = "tdd bez dat: " & tdd_bez_dat_spatne
output.Cells(1, 6) = "Vygenerováno: " & Now & " (" & Round(Timer - t_start, 1) & "s)"
output.Activate
Debug.Print "Konec", Round(Timer - t_start, 2) & " s", "tdd celkem: " & tdd_celkem, "dira: " & tdd_spatne, "bez dat: " & tdd_bez_dat_spatne
End Sub

Toto makro by mělo kontrolovat, že v daných datech nechybí hodnoty, takzvaně najde díru.
Mohou nastat dvě varianty, které nás budou zajímat.
1) Pokud ve sloupci nejsou žádné hodnoty, chci aby mě to ten elektroměr vypsalo „např. elektroměr 1 TDD1 (jako v makru výše - Sloupec B: TDD BEZ DAT CELÝ MĚSÍC)
2) Pokud se ve sloupci objeví status „neznámá hodnota“ většinou data po tomto statusu nepokračují – elektroměr byl demontován. To bych chtěl, aby mě také elektroměr vypsalo. Akorát ještě s časovou značkou z prvního sloupce, toho kdy tento status nastal. Abych věděl ke kterému dni a času se na elektroměr přestala posílat data. (ta funkce s tím časem v makru výše ještě není, tam je jen vyhledat tento případ a poté se vypíše elektroměr bez té časové značky) - to bych potřeboval do makra přidělat. (Momentálně je to sloupec A: TDD OD KDY DO KDY ) a vypisuje se tam jen elektroměr bez té časové značky.
__________________________________________________________________________________________________________
- Když bych to shrnul celkově, tak makro by měli vzít několik souborů (jako jsou v odkazu na začátku, ve složce "data") naimportovat je do jednoho excelovského sešitu do jednotlivých listů, nad těmito jednotlivými listy, by se měla provést kontrola naměřených dat - zda tam nejsou díry. A až se provede kontrola na jednotlivými listy, mělo by se to objevit nejlépe v jednom listě - třeba poslední v daném excelovském sešitu. Tak abych mohl dát jen CTRL C a CTRL V a odeslat emailem
kolegům dále, který tento problém budou řešit.

Je možné, že jsem na něco podstatného zapomněl. Pokusím se reagovat co možná nejrychle na vaše reakce. Nechám tu raději telefon: 724 417 290 - klidně se ozvěte. Doufám, že se tady někdo najde kdo by mě s tím pomohl to dát dohromady. Opravdu bych to potřeboval mít do pondělí hotové. Doufám, že ta část mých maker půjde snad použít. A že se to jen upraví do jednoho makra které se spustí a udělá vše za mě. Děkuji Petr M.

Reklama
guest
Pohlaví: Nespecifikováno

Re: MAKRO EXCEL - Prosím o pomoc.

Příspěvekod guest » 09 lis 2018 12:13

"mělo by se to objevit nejlépe v jednom listě - třeba poslední v daném excelovském sešitu". A jak odlišíte zdroj (sešit, posléze list), když to na sebe nenavazuje a časové řady se překrývají?

"Pokud ve sloupci nejsou žádné hodnoty, chci aby mě to ten elektroměr" - ono se to tamto se to asi se to samo netento... to luštit nehodlám, stejně jako kód kontroly (kdepak já už užití nějakého Timeru v poslední době viděl...)

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

Re: MAKRO EXCEL - Prosím o pomoc.

Příspěvekod elninoslov » 09 lis 2018 12:52

-Určite nekopírovať všetky listy, a potom ich mazať, keď píšete, že treba vždy iba a len 1. list.
-Určite nič nekopírovať nikam, ale načítať UsedRange do poľa, kontrolovať potom pole.
-Najdôležitejšiu otázku položil xlnc - "časové řady se překrývají?"

Uvidím, ako na tom budem s robotou...

EDIT: Ako môže na liste data byť 2x vedľa seba "Elektroměr 2 TDD1", raz s čiastočnými dátami a raz bez dát v rovnakom čase?
V tom druhom súbore je zase "elektroměr TDD1" tuším 6x vedľa seba, a v rovnakom čase má iné dáta.
Proste mi hlava neberie, ako v rovnakom čase môže dať elektromer 6 rôznych hodnôt.
Váš kód sa mi študovať nechce, lebo je pre mňa ťažko stráviteľný. To skôr navrhnem celé sám, ale tomu zase bráni to, že nerozumiem dodanému príkladu. Skúste to objasniť a uvidíme.

majerpetr
nováček
Příspěvky: 2
Registrován: listopad 18
Bydliště: Hradec Králové
Pohlaví: Muž
Stav:
Offline
Kontakt:

Re: MAKRO EXCEL - Prosím o pomoc.

Příspěvekod majerpetr » 09 lis 2018 20:15

TO ELNINOSLOV:
1)-Určite nekopírovať všetky listy, a potom ich mazať, keď píšete, že treba vždy iba a len 1. list.
-> to je určitě lepší varianta rovnou kopírovat jen první list. Já jsem si našel tohle makro tady na fóru a snažil se ho upravit, ale po pravdě mě to moc nešlo, tak mě napadlo jen vymazat ty prázdné =(

2)-Určite nič nekopírovať nikam, ale načítať UsedRange do poľa, kontrolovať potom pole.
->tohle bych nechal na Vás co bude lepší a jednodušší.

3)-Najdôležitejšiu otázku položil xlnc - "časové řady se překrývají?"
->Co se týče časové řady. Zkusím vysvětlit, snad jsem pochopil dobře na co se přesně ptáte. Ve všech souborech s daty bude vždy stejná časová řada - např. jak je uvedeno v těch souborech co jsou k dizpozici ve složce "data". Nikdy se nestane to, že by byla časová řada u jednotlivých souborů s daty rozlišná. Teď tam je u všech souborů časová řada - celého měsíce říjen. Až budu stahovat další várku s daty příští měsíc, bude to zase u všech souboru v dané složce stejná časová řada - ale např. dalšího měsíce a to je listopad. Ale vždy bude stejná časová řada u těch souboru, které se budou kopírovat do jednoho a provádět se na ni ta kontrola.

EDIT:
To se velice moc omlouvám, já musel přepsat názvy elektroměru růčně z důvodů GDPR a zřejmě jsem tam udělal chyby v názvech jednotlivých elektroměrů, proto tam byl ten elektroměr 2 víckrát =( Název elektroměrů bude vždy rozdílný.V každém souboru je elektroměr jen jednou. Nově opravené soubory(data) jsem náhrál znovu na leteckou poštu: http://leteckaposta.cz/298511784.

Vůbec mě to nevadí, jestli to pro Vás bude příjemnější navrhnout celý kód sám, chápu to. Bude to asi i jednodušší pro Vás.
Snad jsem takhle ten příklad vysvětlil, pokud ne ptejte se. Uvidíte jak budete mít čas, vím že Váš čas taky něco stojí, klidně se nebojte říct potom o nějakou peněžní odměnu. Počítám s ní ;) A bylo by fajn kdyby to vyšlo do toho pondělí.

Děkuji Petr M.

guest
Pohlaví: Nespecifikováno

Re: MAKRO EXCEL - Prosím o pomoc.

Příspěvekod guest » 09 lis 2018 22:38

ad 3) Výborná odpověď :-) Máte ještě dva dny na zádání.

MePExG
Level 2
Level 2
Příspěvky: 193
Registrován: srpen 16
Pohlaví: Muž
Stav:
Offline

Re: MAKRO EXCEL - Prosím o pomoc.

Příspěvekod MePExG » 10 lis 2018 17:04

Prikladám riešenie pomocou Power Query (použiteľné od verzie 2010). Stačí do adresára kde bude tento súbor uložený vložiť adresár Data(, alebo zmodifikovať cestu) a na liste Data dať aktualizovať (Data-Aktualizovať, alebo Alt+F5, resp. všetko=Ctrl+Alt+F5)tabuľku a to isté aj na liste KT. Ak chcete môžem Vám zavolať a predviesť použitie.

Dodatečně přidáno po 4 hodinách 33 minutách 15 vteřinách:
Pridávam aj riešenie s agregáciou do dňa, ktoré zmenšuje počet riadkov = jedna udalosť za deň=jeden riadok min=od, max=do a nie všetky riadky s udalosťou.
Přílohy
SpracPQGD.xlsx
(67.35 KiB) Staženo 31 x
SpracPQ.xlsx
(245.07 KiB) Staženo 34 x

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

Re: MAKRO EXCEL - Prosím o pomoc.

Příspěvekod elninoslov » 10 lis 2018 22:16

Mne vyjde iný výsledok. Napr. Vy máte, že "Elektroměr 1 TDD4" je bez dát. To je aj nieje pravda. On totiž má ukončenie 00:00:00 v 1. dni nasledujúceho mesiaca. Preto Vám to tam asi skáče takto. Ja som si až teraz uvedomil, že moje riešenie považuje za "bez dát" keď je celý stĺpec bez dát. To ale nemusí byť jeden mesiac. Kľudne to môže byť od 15.4. do 15.6. A potom by mal byť "bez dát" 1,2 alebo 3 mesiace ? Celé divné...

EDIT: Ešte dodám, že ja za výpadok považujem aj to keď je medzi dvoma výpadkami len x stavov "neznáma hodnota". To mi príde zrejmé, že to je spôsobené práve tým výpadkom.
Přílohy
makro kontrola.xlsm
(33.87 KiB) Staženo 32 x

MePExG
Level 2
Level 2
Příspěvky: 193
Registrován: srpen 16
Pohlaví: Muž
Stav:
Offline

Re: MAKRO EXCEL - Prosím o pomoc.

Příspěvekod MePExG » 11 lis 2018 07:53

Dobrý deň. Na "chybu", že pri totožnej udalosti, ktorá ma viac výskytov zobrazuje min a max začiatok prvej a koniec druhej, alebo poslednej, som prišiel hneď pri kontrole a autor požiadavky o tom vie. Riešenie však veľmi jednoduché - do kt stačí zaviesť za, alebo pred stav deň z dátumu a už budú zobrazené dve udalosti aj keď totožné. Toto mám vyriešené v súbore gd, v ktorom data majú menej riadkov, lebo sa agregujú (min a max dátum a čas) na deň.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Makro pro myš Rapture Python
    od mmmartin » 27 srp 2023 15:18 » v Problémy s hardwarem
    9
    1111
    od mmmartin Zobrazit poslední příspěvek
    29 srp 2023 16:47
  • Excel a OneDrive
    od sginfo » 11 zář 2023 15:28 » v Kancelářské balíky
    16
    5993
    od mirekol Zobrazit poslední příspěvek
    20 říj 2023 08:31
  • Excel - funkce když
    od Martyn20 » 13 črc 2023 11:56 » v Kancelářské balíky
    5
    2325
    od mmmartin Zobrazit poslední příspěvek
    13 črc 2023 18:44
  • Excel - vlastní formát Příloha(y)
    od Story-Long » 11 srp 2023 14:50 » v Kancelářské balíky
    3
    1841
    od Story-Long Zobrazit poslední příspěvek
    14 srp 2023 10:11
  • Excel - problém se vzorci
    od honzzicek » 28 čer 2023 21:45 » v Kancelářské balíky
    2
    1641
    od honzzicek Zobrazit poslední příspěvek
    01 črc 2023 08:57

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 4 hosti