Příspěvky uživatele

Príklad, ktorý zvláda aj zmenu vo viacerých bunkách naraz. Skúste, ale je už zložitejší.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, ARE As Range, O(), I(), AreR As Long, y As Long, bol As Boolean

Set Zmena = Intersect(Columns(15), Target)

If Not Zmena Is Nothing Then
Application.EnableEvents = False

For Each ARE In Zmena.Areas
With ARE
If .Rows.Count = 1 Then
ReDim O(1 To 1, 1 To 1): O(1, 1) = .Value
ReDim I(1 To 1, 1 To 1): I(1, 1) = .Offset(0, -6).Value
Else
O = .Value
I = .Offset(0, -6).Value
End If

bol = False
For y = 1 To UBound(O, 1)
If O(y, 1) = "Ano" Then I(y, 1) = "-": bol = True
Next y

If bol Then .Offset(0, -6).Value = I
End With
Next ARE

Application.EnableEvents = True
End If
End Sub

Ešte by som tam prípadne doplnil kontrolu, či ten otvorený súbor má správnu cestu. Ľahko sa môže stať, že otvorený súbor bude iný, napr. záložnom adresári, či napr. minulomesačný súhrn, ... len sa bude volať rovnako. Možností ako to spliesť je veľa. Pre istotu. Treba na to myslieť, lebo operácie makrom nemajú Undo.
Sub Makro2()
Dim WB As Workbook, Zosit As String, Cesta As String

Cesta = "D:\Download\"
Zosit = "Príklad KT.xlsx"
On Error Resume Next
Set WB = Workbooks(Zosit)
On Error GoTo 0
If WB Is Nothing Then
Set WB = Workbooks.Open(Cesta & Zosit)
Else
If WB.Path & "\" <> Cesta Then
MsgBox "Je otvorený nesprávny súbor" & vbNewLine & WB.Path & "\" & Zosit & vbNewLine & vbNewLine & _
"Použite správny súbor" & vbNewLine & Cesta & Zosit, vbCritical
Exit Sub
End If
End If

With WB
.Activate 'Activate nieje potrebné na bežné veci. Stačí sa odkazovať na WB alebo použiť with s bodkovou notáciou
'práca s daným zošitom
End With
End Sub

2 príklady, je to úplne jednoduché:
Sub Makro1()
Dim Zosit As String, Cesta As String

Cesta = "D:\Download\"
Zosit = "Príklad KT.xlsx"
On Error Resume Next
Workbooks(Zosit).Activate
If Err.Number <> 0 Then Workbooks.Open Cesta & Zosit
On Error GoTo 0

'práca s daným zošitom ActiveWorkbook
End Sub

Sub Makro2()
Dim WB As Workbook, Zosit As String, Cesta As String

Cesta = "D:\Download\"
Zosit = "Príklad KT.xlsx"
On Error Resume Next
Set WB = Workbooks(Zosit)
On Error GoTo 0
If WB Is Nothing Then Set WB = Workbooks.Open(Cesta & Zosit)

With WB
.Activate 'Activate nieje potrebné na bežné veci. Stačí sa odkazovať na WB alebo použiť with s bodkovou notáciou
'práca s daným zošitom
End With
End Sub

Vy máte teda denne nejaký jeden export z nejakého SW do XLSX súboru s asi 30K riadkami ?

Tento súbor je vždy jeden a ten istý, alebo je to každý deň nový súbor ? (ak nový, čím sa odlišuje v názve ?)

Z tohoto súboru/súborov potrebujete na dennej báze vybrať 2 najnižšie dátumy a 1 najvyšší dátum z každého súboru samostatne, a tieto data (okrem riadkov Distribuce) skopírovať do nejakého súhrnného súboru, ktorý sa bude raz za polrok vyhodnocovať ?

Ak bude každý deň 1 súbor s 30K riadkami takže polročne to bude +- 5M riadkov? To by malo PQ dať do pár sekúnd.

Ak sa jedná o variant denného vyextrahovania iba tých 3 dátumov a odloženia do súhrnného súboru, tak to cez pole musí byť otázka sekúnd (s vytvorením parametru pre filter, alebo rovno vydolovanie poľa nieje prob.), nie minút (asi to robíte po bunkách s Copy/Paste).

Dovysvetlite, prípadne najlepšie uveďte na tomto konkrétnom súbore, čo bude výsledok.

ovechkin888: buď máte prílohu veľkú, alebo je to *.xlsm súbor. Treba ju zmenšiť zredukovaním nepotrebných dát do 256 KB. Na ukážku netreba kompletné súbory, stačí reprezentatívna, priekazná vzorka so zachovaním rozmiestnením, formátom, a druhom údajov, a ich eventualít. Ak je to xlsm tak zaZipovať.

Takže, napr. v PowerQuery si nájdem a adresári najnovší súbor Data. Načítam si z neho údaje a vyriešim tie zhovadilosti s medzerami. Nechám si iba riadky, kde v "datum" nič nieje. Rovnako ako v predchádzajúcom príklade si vyriešim tie medzery aj s dátami v liste Kontrola. Stále som v PQ. Čo má byť účelom toho celého? Čo majú byť "další upravy" podľa zmienky v makre? Pýtam sa, pretože nerozumiem ani tomu, či sa majú do listu Data vypísať iba také záznamy zo súboru Data, ktoré zároveň niesú v liste Kontrola, alebo opačne iba také, ktoré sú v liste Kontrola a zároveň aj v súbore Data. Záleží na tom, čo potrebujete, podľa toho bude následný postup, a možno makro nebude treba.

JJ, ale aj tak si myslím, že vrah bude ten záhradník

ovechkin888, musíte priložiť nejakú prílohu s príkladom vstupu aj výstupu...

S tým žiaľ nepomôžem ...

Ak iba aktívny list linkovaného zošitu tak:
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
ActiveWindow.Zoom = 60
End Sub
ak všetky listy linkovaného zošitu tak:
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim WS As Worksheet, bAct As Worksheet
Application.ScreenUpdating = False
Set bAct = ActiveWorkbook.ActiveSheet
For Each WS In ActiveWorkbook.Worksheets
WS.Activate
ActiveWindow.Zoom = 60
Next WS
bAct.Activate
Application.ScreenUpdating = True
End Sub
prípadne použiť pole názvov listov a zoomovať ich naraz:
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim WS As Worksheet, bAct As Worksheet, L As String
Application.ScreenUpdating = False
With ActiveWorkbook
Set bAct = .ActiveSheet
For Each WS In .Worksheets
L = L & IIf(LenB(L) = 0, vbNullString, "?") & WS.Name
Next WS
.Worksheets(Split(L, "?")).Select
End With
ActiveWindow.Zoom = 60
bAct.Select
Application.ScreenUpdating = True
End Sub
Makro dať do modulu ThisWorkbook keď chcem "chytať" všetky linky v našom zošite (vo všetkých listoch), alebo do modulu daného listu ktorý chceme checkovať, len potom je definičný riadok procedúry iný
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

Dá sa aj maticou bez pomocného stĺpca:
=INDEX(D3:D7;MATCH(MAX(COUNTIF(D3:D7;D3:D7));COUNTIF(D3:D7;D3:D7);0))
=INDEX(D3:D7;POZVYHLEDAT(MAX(COUNTIF(D3:D7;D3:D7));COUNTIF(D3:D7;D3:D7);0))

Function Create_Dir_Structure(D As String) As Boolean
Dim S() As String, i As Byte, Cesta As String

If Len(D) < 3 Then Exit Function
S = Split(D, "\")
If UBound(S) = 0 Then Exit Function

Cesta = S(0)
On Error GoTo KONIEC

For i = 1 To UBound(S)
Cesta = Cesta & "\" & S(i)
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
Next i

KONIEC:
Create_Dir_Structure = Err.Number = 0
End Function

Sub pokus()
Dim disk As String, slozka As String

disk = "C:"
slozka = "slozkaDomy"

If Not Create_Dir_Structure(disk & "\" & slozka & "\systemObsazen1") Then
MsgBox "Chyba. Adresár nebol vytvorený.", vbCritical
Exit Sub
End If
End Sub

marjankaj: No toto práve nestačí na to, aby to po stlačený farby spočítalo. Treba vyvolať prepočet.

Ako píše mepexg: Jednoduchšie by bolo to spraviť cez KT, alebo prípadne COUNTIF/SUMIF/matica, a zadávať nejaké hodnoty, nie farby. Najskôr KT.
Ale stále nieje príloha.

Už zase tie počty podľa farieb, a zase rovnaký problém. Excel nemá štandardnú funkcionalitu na odchytávanie zmeny farby. Jediné riešenie, ktoré by bolo ako tak akceptovateľné, je opäť cez vytvorenie triedy CommandBars v móde WithEvents, a kontrola Update CommandBar-u. Ale to má svoje muchy, napr. nedá sa to dobre použiť v UDF funkcii, nevyvolá ju. Je tam aj iné správanie v Debuggery a iné v reále. Minule som to pri niečom robil, ak to nájdem, možno ..., ale dnes bez prílohy nie. Nedarí sa, a nemám chuť na nič ...

Buď 0 skryte vo formáte bunky, alebo vzorec zopakujte v podmienke:
=IF(COUNTIFS(...)=0;"";COUNTIFS(...))

Tabuľku iba skopírujete, a zmeníte "názov".

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje