• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Súbor otvárať nemusíte. Môžete použiť buď metódu ExecuteExcel4Macro, alebo vzorec do nepoužívanej bunky.
Sub Porovnaj()
Dim Hodnota
With ThisWorkbook.ActiveSheet
With .Range("H4")
.Formula = "='" & ThisWorkbook.Path & "\[TEST2.xlsm]List1'!$D$5"
Hodnota = .Value
.ClearContents
End With

If Hodnota = .Range("D5").Value Then
MsgBox "Bunky se rovnají"
Else
MsgBox "Bunky se NErovnají", vbCritical
End If
End With
End Sub
Sub Porovnaj2()
Dim Hodnota
With ThisWorkbook
Hodnota = Application.ExecuteExcel4Macro("'" & .Path & "\[TEST2.xlsm]List1'!R5C4")
If Hodnota = .ActiveSheet.Range("D5").Value Then
MsgBox "Bunky se rovnají"
Else
MsgBox "Bunky se NErovnají", vbCritical
End If
End With
End Sub
Na pár buniek ExecuteExcel4Macro rýchlostne v pohode. Na tisíce použite z týchto dvoch metód radšej tie vzorce.

Public Sub PridajHyperlink()
'Pridať referenciu na Microsoft Word 16.0 Object Library
Dim objItem As Object
Dim objInsp As Outlook.Inspector
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection

On Error Resume Next
Set objItem = Application.ActiveInspector.CurrentItem

If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection

With objSel
If Len(.Text) > 1 Then .Hyperlinks.Add .Range, .Text
End With
End If
End If
End If

Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objDoc = Nothing
Set objInsp = Nothing
End Sub
Pridať Modul, pridať referenciu, kód do modulu. Pridať na karte Vložiť novú skupinu, pridať do nej makro. Vo VBA editore Uložiť.
V Centre zabezpečenia v nastaveniach treba povoliť všetky makrá.

Tak?

Skúste toto. Upravil som podmienený formát (to si nastavte), zjednotil Browse tlačítka, upravil makro, ale teraz Vám zase na vzorovom súbore nesedia tie adresy buniek, na ktoré má hyperlink odkazovať. V tabuľke máte iné názvy listov ako "Souhrn", ktorý tvrdíte, že tam bude, a z ktorého sa majú ťahať data. Nerozumiem Vám presne...

Úprava:
Sub FILTR4()
Dim i As Long
Dim ARE As Range
Dim Vzorec As String

Application.ScreenUpdating = False

'CZ
'Vzorec = "=SVYHLEDAT(List1!D•;List2!$B:$C;2;0)"

'SK
Vzorec = "=VLOOKUP(List1!D•;List2!$B:$C;2;0)"

With List1
'Projde všechny vyfiltrované spojité podoblasti - Areas
For Each ARE In .Range("E7:E" & .Cells(Rows.Count, 4).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Areas
With ARE
.FormulaLocal = Replace(Vzorec, "•", .Row) 'Vloží do nich upravený vzorec, kde se mění "•" za 1. řádek podoblasti
.Value = .Value 'Převod vzorce na hodnotu
End With
Next ARE
End With

Application.ScreenUpdating = True
Set ARE = Nothing
End Sub

Čo znamená že je prázdny? Že tam nieje vôbec žiadna Tabuľka? Veď tú nemažte aj s hlavičkami. Samotný Objekt Tabuľka s hlavičkami a prvým aj keď prázdnym riadkom sa necháva. Vy chcete aby sa kontrolovalo, či existuje Tabuľka "tblKopieM", ak nie tak ju vytvoriť a naformátovať (farba, tučné, vystredenie, formát, dátum, veľkosť, výška, ...), ale to samozrejem iba v prípade, že existuje list "Kopie makro". Ak ani ten nieje, tak ho vytvoriť, a následne v ňom tú Tabuľku....
A nieje jednoduchšie, aby tam ten list aj s tou Tabuľkou stále bol?

Oprava, musí sa to urobiť po oblastiach:
Sub FILTR4()
Dim i As Long
Dim ARE As Range
Dim Vzorec As String

Application.ScreenUpdating = False

Vzorec = "=D•+$E$5"
With List1
For Each ARE In .Range("E7", .Cells(Rows.Count, 5).End(xlUp)).SpecialCells(xlCellTypeVisible).Areas
With ARE
.FormulaLocal = Replace(Vzorec, "•", .Row)
.Value = .Value
End With
Next ARE
End With

Application.ScreenUpdating = True
Set ARE = Nothing
End Sub

Pokus:
Sub FILTR3()
Dim MaxRadek As Long
Dim OblastA As Range
Dim Vzorec As String

Application.ScreenUpdating = False

MaxRadek = List1.Cells(Rows.Count, 4).End(xlUp).Row

Set OblastA = Range("E7:E" & MaxRadek).SpecialCells(xlCellTypeVisible)

Vzorec = "=D•+$E$5"
With OblastA
.FormulaLocal = Replace(Vzorec, "•", .Row)
.Value = .Value
End With

Application.ScreenUpdating = True

Set OblastA = Nothing

End Sub
Znak "•" nahradzuje vo vzorci relatívnu pozíciu, ktorá sa naraz nahradí za riadok prvej bunky, ktorá je vyfiltrovaná, ostatné si už potom Excel vyplní. Ak máte vo vzorci odkazy na viac relatívnych buniek rôznych riadkov, nájdite si teda ďalšie znaky (reťazce), ktorými ich nahradíte. Musel by som vidieť reálny vzorec a rozmiestnenie.

PS: Ak by išlo iba o pripočítanie nejakého čísla, tak stačí :
With List1
.Range("E5").Copy
.Range("E7", .Cells(Rows.Count, 4).End(xlUp)).SpecialCells(xlCellTypeVisible).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
End With

Čo je to ActDate? Nikde premennú nenapĺňate. Čo je FromDate? Bunka C2 (Cells(2, 3)) na liste Zadání je prázdna.

EDIT: Inak ja to makro iba prekopírujem do Vašeho súboru, zmením názov listu Štart na Zadání a makro fičí. Podľa času to ale aj tak prerobím na pole.

Ale veď to je spôsobené tým, že nemám tie Vaše súbory. Ako mám vedieť ktorý stĺpec použiť na zistenie počtu riadkov, na ktorom riadku začínajú údaje, je/nieje tam hlavička, atď. Predpokladám, že chyba je v tom, že v zdrojových súboroch nezačínajú dáta na 4 riadku, ako som vyčítal z Vašeho kódu
...
SRow = 4
...
s premenná SRow má zápornú alebo 0 hodnotu. Keď Vám to dá chybu, choďte na premennú kurzorom, vypíše hodnotu. Tá jest ?

Dodajte reálny súbor (citlivé dáta zmente), a keď bude čas, urobím to bez kopírovania, cez pole do predformátovanej oblasti. Teda dúfam, že ten dátum bude stále iba v jednom stĺpci. Či?

Nie, toto nedám ani ja. Nielen že nemám posledné dni vôbec čas, ale ešte ani netuším o čom sa tu bavíte. To akože v bunke je celý kód nejakého makra, ako text, a ten sa má vykonať ???

Skôr si myslím, že by ste v bunke mal mať napr názvy makier:
"Prehod_tabulky"
"Filtruj_a_zorad"
"Importuj_CSV"
...
A tieto makrá zmenou v bunke spúšťať. A kód makier, bude normálne v module, alebo v PERSONAL.XLSB, alebo ako doplnok v Ribbone, ...

Priložte príklad v súbore. Vzorec, čo ste napísal, je nezmysel. A ak je v B1, tak je zacyklený. Ak je inde vracia výsledok porovnania A1 = B1, teda TRUE/FALSE (PRAVDA/NEPRAVDA), a nie hodnotu. Proste nezmysel. V súbore uveďte aj to z čoho sa vypočítava % plnenie v oboch prípadoch, a aj to, aký ma byť výsledok.

To Vaše makro nieje vhodne urobené. Ide bunku po bunke, teda pomaly. Keďže nemám súbory, tak som sa len pokúsil uhádnuť, čo v tom makre robíte, a prerobiť to, aspoň z časti na čo najviac hromadných vecí, aby to bolo rýchlejšie (oblasti, polia). Každopádne to skúste VÝHRADNE NA KÓPII DÁT! Naozaj potrebujete kopírovať formáty buniek ? Pretože ak sú dáta rovnakého typu vo všetkých stĺpcoch a v celých stĺpcoch, tak sa formáty nemusia kopírovať, ale predformátuje sa ten stĺpec. Z toho vyplýva, že by sa mohlo vynechať pomalé kopírovanie, a urobiť to celé cez rýchle polia. A najlepšie by asi bolo, aby dáta vydolovalo PowerQuery. Tam by ale bolo asi potrebné urobiť v PowerQuery cyklus, a v tom M-code nie som zatiaľ taký zbehlý. Bude ale potrebné priložiť nejaké zdrojové ukážkové súbory.
Vyskúšajte.

Typ dát v jednotlivých stĺpcoch? Rozsah dát? Dizajn formu? Čo znamená "výsledky jednotlivých sloupců" ??? Každý stĺpec sa má vo výsledku radiť samostatne (teda nie celý riadok B:H ak je zhoda v E)? Príloha? ...

Sub HL()
Dim Cesta As String, Bunka As String
With Worksheets("Souhrn")
Cesta = Replace(Replace(.Range("Q2").Value, "[", ""), "]", "")
Bunka = Replace(Replace(.Range("O2").Value, "[", ""), "]", "")
.Range("N2").Hyperlinks.Add Anchor:=.Range("N2"), Address:=Cesta, SubAddress:=Bunka, TextToDisplay:="Link"
End With
End Sub
Toto je len ukážka. Rovno v tom makre čo máte, počítajte pozíciu bunky (asi cyklom alebo neviem ako to máte) v .Cells() a vkladajte.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse