Příspěvky uživatele


< návrat zpět

Strana:  1 ... « předchozí  280 281 282 283 284 285 286 287 288   další » ... 300

Pretože ma nenapadá ako inak zistiť počet riadkov v zatvorenom zošite, a potom tieto riadky skopírovať aj s Hyperlinkom (HL). Na môj návrh spočítať riadky vzorcom v pomocnej bunke (v schovanom stĺpci, liste ...), alebo použitie Excel4Macro, nikto nereflektoval.
Vzorec HL nezkopíruje, ale na opätovné vytvorenie HL som sem makro dal. Testovať to nejdem, ale možno vytvorenie inštancie Excelu + Copy Paste, bude trvať kratšie ako nakopírovanie potrebného počtu vzorcov, prebehnutie 1000 buniek kvôli vytvoreniu HL.
Ale možno ide kopčiť HL so zatvoreného zošitu, aj inak. Zatiaľ ďalej neskúmam.

U mna sa nič také neprejavovalo, ale skúsim si z tabletu tipnúť:
1. Nezabudli ste na zrušenie inštancie Excelu v pamäti ? Keđže táto inštancia je vlastníkom toho zošitu, mal by byť zrušený spolu s nou.
Set EXA = Nothing
2. Ak nepomôže, tak skúste
Sub Aktualizuj()
Dim EXA As Excel.Application, WB as Workbook
Set EXA = CreateObject("Excel.Application")
Set WB = EXA.Workbooks.Open(Application.ThisWorkbook.Path & "\data.xlsx").Worksheets("Hárok1")
With WB
.Range("A:D").Resize(.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).Copy
Windows("prepojenie.xlsm").Activate
With ThisWorkbook.Worksheets("Hárok1").Range("A:D")
.Clear
.Cells(1, 1).Activate
Application.CutCopyMode = False
ActiveSheet.Paste
.Cells(1, 1).Select
End With
End With
Set WB = Nothing
Set EXA = Nothing
End Sub

3. Prípadne vyskúšať ako posledný príkaz v konštrukcii
With WB...
doplniť
.Close
4. Skontrolujte si v Správcovy procesov (Ctrl+Shift+ESC), či Vám nebežia đalšie inštancie Excelu z predošlých pokusov. Ak áno, tak pklik a Ukončiť proces.

Ešte by sa to dalo celé riešiť napr aj takto :
Sub AktualizujHyp()
Dim Bunka As Range, H As String, R As Long
Dim EXA As Excel.Application, WB As Workbook, WS As Worksheet
Set EXA = CreateObject("Excel.Application")
Set WB = EXA.Workbooks.Open(Application.ThisWorkbook.Path & "\data.xlsx")
Set WS = WB.Worksheets("Hárok1")
R = WS.Range("A:D").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With ThisWorkbook.Worksheets("Hárok1")
With .Range("A:D")
.ClearContents
.Resize(R) = WS.Range("A:D").Resize(R).Value
End With
WB.Close False
Set EXA = Nothing
If R = 1 Then Exit Sub
For Each Bunka In .Cells(2, 4).Resize(R - 1)
If Not IsEmpty(Bunka) Then
With Bunka
H = .Value
H = IIf(Left(H, 4) = "http", "", "http://") & H
With .Hyperlinks
If .Count = 0 Then .Add anchor:=Bunka, Address:=H Else Bunka.Hyperlinks(1).Address = H
End With
End With
End If
Next Bunka
End With
End Sub

Predošlé makro doplnené a zaujímavý spôsob prístupu do zatvoreného súboru od Paloo, čerpané odtiaľto:
http://wall.cz/index.php?m=topic&id=24364#post-24377
Treba to ale ešte zabezpečiť na odchyt chýb, pretože to vytvára samostatnú aplikáciu Excel (skrytú), a akonáhle príde k nejakej chybe, tak tento druhý Excel ostane visieť s alokovanými zdrojmi, teda aj zamknutým data.xlsx pre zápis.
V tomto prípade by možno šlo použiť aj Copy Paste, a nemusia sa potom upravovať linky v prípade, že sú to http linky, a nie len www. Mne totiž www neotvorí, iba http. Takže ak to nieje len nesprávnym nastavením môjho Excelu, a chcete mať zobrazené názvy linkov tak ako ich máte, potom treba urobiť aj tú spodnú časť kódu.

EDIT:
Tak toto je metóda, ako skopírovať celú použitú oblasť z data.xlsx aj s formátovaním a hyperlinkami proste tak ako to je v data.xlsx. Ale ako som spomínal, treba zvážiť počet plánovaných riadkov, či nebude lepšie použiť Excel4Makro a počet riadkov mu určí schovaný vzorec s COUNTA, alebo presypať cez Value, alebo vložiť vzorec, a upraviť Hyperlinky bunku po bunke.
Sub Aktualizuj()
Dim EXA As Excel.Application
Set EXA = CreateObject("Excel.Application")
With EXA.Workbooks.Open(Application.ThisWorkbook.Path & "\data.xlsx").Worksheets("Hárok1").Range("A:D")
.Resize(.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).Copy
Windows("prepojenie.xlsm").Activate
With ThisWorkbook.Worksheets("Hárok1").Range("A:D")
.Clear
.Cells(1, 1).Activate
Application.CutCopyMode = False
ActiveSheet.Paste
.Cells(1, 1).Select
End With
End With
Set EXA = Nothing
End Sub

Pre nastavenie Hyperlinkov možno použiť makro :
Sub AktualizujHyp()
Dim Bunka As Range, H As String, R As Long
With ThisWorkbook.Worksheets("Hárok1")
R = .Range("A:D").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
If R = 0 Then Exit Sub
For Each Bunka In .Cells(2, 4).Resize(R)
If Not IsEmpty(Bunka) Then
With Bunka
H = .Value
H = IIf(Left(H, 4) = "http", "", "http://") & H
With .Hyperlinks
If .Count = 0 Then .Add anchor:=Bunka, Address:=H Else Bunka.Hyperlinks(1).Address = H
End With
End With
End If
Next Bunka
End With
End Sub

Nechať ho spustiť napr po otvorení súboru.
Treba ale predikovať, koľko riadkov má byť zaplnených vzorcami, keďže netuším, aká by sa dala aplikovať funkcia na zistenie počtu zaplnených riadkov v zatvorenom zošite, okrem :
1. vzorec v pomocnom liste alebo bunke
=COUNTA('Z:\Prepojené zošity\[data.xlsx]Hárok1'!A:A)
2. cyklické prechádzanie buniek v A:A cez ExecuteExcel4Macro, to je ale pomalé.

Ak tento vzorec vložíte do bunky A2, a rozkopírujete ho na všetky potrebné stĺpce a riadky, bude kopírovať údaje zo zatvoreného Data.
=IF([data.xlsx]Hárok1!A2="";"";[data.xlsx]Hárok1!A2)
Ale nie hyperlinky. To by sa muselo pravdepodobne makrom, pri otvorení zošita, alebo pri nej príležitosti (časovač, aktivácia, klik...).

No už to sem dám, čo s tým:
1. Hárok2 - Tam je na to vzorec, odtiaľ si skopírujte len celý stĺpec A a niekam vložte, Poznámkový blok atď.
2. makro ExportTXT to robí celé makrom, vytvorí/prepíše súbor Zasobnik2.TXT
3. makro ExportTXT2, použije ako zdroj vzorce z Hárok2, vytvorí/prepíše súbor Zasobnik3.TXT

1. - treba ešte ukladať v niečom data
2. - pomalé
3. - toto je najlepšia a najrýchlejšia možnosť

Priložené sú aj vzorce v TXT (aj rozložené, aj zložené), dali by sa urobiť aj inak, napr. maticovo s potrebnou šírkou v maticovej konštante, ale bola by tam veľká komplikácia so znamienkami "+" iba u niektorých stĺpcov, "%" atď.

Mám to pre Vás už vyriešené vzorcom. Ešte dopilovávam aj makro verziu. Nezabudli sme na Vás, nebojte 1
Dám Vám to sem naraz.

With ThisWorkbook 'Pro tento sešit
With .Worksheets("Datový list")
N = .Range("A26") & " " & .Range("C26") 'Název pro nový list
End With
Cesta = .Path & "\"
With .Worksheets("Protokol")
.Buttons("btnOdeslatUlozit").Visible = False 'Skryť tlačítko
On Error Resume Next
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cesta & N, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err <> 0 Then
MsgBox ("Chyba při exportu do" & vbNewLine & Cesta & N)
Err.Clear
End If
On Error GoTo 0
.Buttons("btnOdeslatUlozit").Visible = True 'Zobraziť tlačítko
End With
End With

Tak na toto sa Vám žiaľ nedám. Jednoduchší vzorec? Excel nemá žiadnu metódu, aby vzorcom zistil počet a názvy listov, duplom nie dynamicky. Jedine cez VBA.
Tie názvy by museli byť niekde uložené, pomocný stĺpec, list, maticová konštanta.
Potom vytvoriť maticový vzorec na beh po všetkých listoch cez INDIRECT, v tom ďalšia matica na kontrolu všetkých riadkov, v tom vyhľadávanie slova. Všetko ošetrené na chybu, na nevyplnené listy, na nevýskyt slova... Ďalej toto všetko (asi v ďalšej matici) radiť pod seba ako výsledky bez prázdnych riadkov. Ďalej budú tam vždy zadané 2 slová ? Čo ak sa stane že bude 1 alebo 3 ? Musí sa vyhľadať posledné slovo, čo tiež nieje malý vzorec. Všetky tieto matice sa budú pravdepodobne viackrát opakovať v každom jednom vzorci, tie isté kvôli podmienkam. Niečo také v jednej bunke bez zlúčenej tabuľky, definovaného názvu, bez známych listov, a jednoduchším vzorcom, nieje možné, a je to dosť ťažko vôbec premysliteľné, nie ešte prevediteľné.

Snáď Vám niekto poradí viac.

Dúfam, že to odborníkom na maticové vzorce uľahčím. Urobil som pomocný list Temp (ktorý sa schová), v ktorom sú vzorcom spojené tabuľky. Reaguje dynamicky.
Teraz už len treba odborníka na maticové vzorce, aby Vám urobil vzorec, ktorý bude z tejto zlúčenej tabuľky vyhľadávať, a pod seba vypísať iba validné údaje.
Podobným vzorcom, ako som dal do List1!A4, vypočítať index validného riadku, a vypísanie všetkých údajov z tohto riadku už nebude problém. Tento môj pokusný vzorec ale nefunguje, treba ho upraviť/opraviť/zmeniť. V poli SMALL už sú správne TRUE, FALSE, ale ja ich odtiaľ neviem očíslovať :(

EDIT:
Tak som to nakoniec nejako poriešil, prikladám novú prílohu, ktorá funguje ako popisujete :

PS: Vzorce si treba natiahnuť pokiaľ potrebujete + rezerva

Alebo by sa dalo zmeniť vzorce na používanie konštanty MAXR, ktorú nastavíte na toľko riadkov, koľko potrebujete, a nemusíte meniť vzorce pri inej požiadavke na riadky. Záleží na tom ako často budete meniť počet riadkov.

Snáď je to to, čo ste chcel. Upravil som ten vzorec od pepe74287. Máte tam možnosť nastavenia akého čísla sa to týka, a aký je limit počtu za sebou idúcich čísel, aby bol výsledok 0.

PS:

mohl byste mi pomoci jak v tech 25 skupinách po 40 najít dvoujky za sebou? a kdyz pudou dvě dvojky po sobě tak napsat delku skupiny 0 jinak délku skupiny?

Snáď ste tým "délka skupiny" myslel počet výskytov čísla, a nie skutočnú dĺžku skupiny, keďže tá je daná, v tomto prípade na 40.

Vašim potrebám, by to snáď vyhovovalo aj takto. Je to iba "hlúpy" vzorec, čiže počíta s 0,1,2 výskytami "-" (viac nekontroluje), a vracia prvý výskyt XX-XXX. Čiže ak Vy tam máte v niektorých bunkách XX-XXX 2 krát (napr. TouchNTuff 93-300 93-700 PS CS), vráti iba prvý výskyt.

Taký druh rozsahu aký spomínate (nesúvislý multicolumn), nastavíte takto.

@pepe74287: Tu máte reupload toho posledného súboru od hans66.


Strana:  1 ... « předchozí  280 281 282 283 284 285 286 287 288   další » ... 300

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje