Příspěvky uživatele

Predpoklad vrátenia správneho písmena disku je:
-uložený súbor (nie iba nový a neuložený)
-neotvárať z archívu (ten sa rozbalí do Tempu - predvolene C:)
Tu máte už uvedené príklady v súbore, a mne fungujú.

Nie. Použite teda spojenie pomocou pomocného skrytého stĺpca. Vymyslite si podobne koncipovaný vzorec, ktorý bude vždy pridávať daný riadok k už spojeným, a Vy budete čítať iba poslednú hodnotu, ktorej pozíciu vhodne umiestnite.

Vygooglené-upravené

Ďalší príklad:
Function SPOJTEXT(rng As Range) As String
Dim ADR As String
ADR = rng.Columns(1).Address
SPOJTEXT = Replace(Replace(Join(Evaluate("=TRANSPOSE(IF(" & ADR & "<>""""," & ADR & ",""""))"), "•°"), "°•", vbNullString), "•°", ",")
If Right$(SPOJTEXT, 1) = "," Then SPOJTEXT = Left$(SPOJTEXT, Len(SPOJTEXT) - 1)
End Function

Napríklad:
Sub pokus()
Dim Subor As String, Bodka As Long
Subor = "Z:\Pokus súbor.xls"
Bodka = InStrRev(Subor, ".")
If Bodka > 0 Then
If LCase(Right$(Subor, Len(Subor) - Bodka)) <> "xlsm" Then Subor = Left$(Subor, Bodka) & "xlsm"
Else
Subor = Subor & ".xlsm"
End If
ThisWorkbook.SaveAs Filename:=Subor, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

Ktorá časť tabuľky sa má kopírovať ? Tú ktorú si práve označíte, alebo nejaká stále rovnaká časť ?

Kam sa má vložiť, pod ktorú tabuľku? Pod tabuľku v liste "ADAMCOVÁ Karla" ? Alebo na akomkoľvek liste, kde bude to tlačítko (predpokladám viac listov) ?

Čo si predstavujete pod pojmom "Kopírovať časť tabuľky" ? Kopírovanie formátu, okrajov, farieb, hodnôt, vzorcov, overenia dát ... ? Alebo iba hodnôt ?

Označte v prílohe pôvodný stav a na kópii listu výsledok aký chcete mať po stlačení čudlíku.

Toto vzorcom nepôjde. Musíte použiť makro. Tu sú 2 príklady. Jeden vypíše zoznam a počet obrázkov "*.jpg", a druhý robí opačnú vec, kontrolu existenciu súboru cez UDF. Pozor, ak treba zaradiť do zoznamu aj "*.jpg" aj "*.JPG" alebo aj "*.jpeg" či "*.JPEG", treba to urobiť inak.

Rozhodne 2. možnosť. Inak by to bolo veľké riziko. Nezabudnite, že operácie makrom nemajú Undo. Čo ak poseriete iný súbor ? Určite Open dialog.

Sheets(1).Protect Password:="heslo", UserInterFaceOnly:=True
Makru povolí všetko, ale list bude zamknutý. Netreba odomykať. Ale treba to urobiť vo Workbook_Open. Čo so sebou nesie zase nutnosť mať jeden VeryHidden list napr. s logom, ktorý pri uložení ako jediný nechá Visible, pri otváraní bude zobrazený teda len list s logom, pokým sa nepovolia makrá, v tom momente sa ostatné odokryjú a logo sa schová.

Skúste toto:
Sub Nastav()
Application.OnKey "{105}", "devina"
Application.OnKey "{103}", "sedma"
...
End Sub
Kódy by mali byť :
vbKeyNumpad0 96 0
vbKeyNumpad1 97 1
vbKeyNumpad2 98 2
vbKeyNumpad3 99 3
vbKeyNumpad4 100 4
vbKeyNumpad5 101 5
vbKeyNumpad6 102 6
vbKeyNumpad7 103 7
vbKeyNumpad8 104 8
vbKeyNumpad9 105 9
vbKeyMultiply 106 *
vbKeyAdd 107 +
vbKeySeparator 108 ENTER
vbKeySubtract 109 -
vbKeyDecimal 110 .
vbKeyDivide 111 /

Skúste aktualizovať Office, Windows, ovládače grafickej karty.
Office 2016 365 Click 2 Run (C2R) sa aktualizuje priamo v aplikácii, Súbor - Konto - Aktualizovať.
Office 2016 Pro sa aktualizuje cez Windows Update, kde musíte mať zaškrtnutú cca takúto vetu "Aktualizovať aj ostatné aplikácie Microsoft", či tak nejak.
Grafickú kartu aktualizujte:
a) na webe výrobcu PC
b) na webe výrobcu grafiky
Skúste najskôr za a).

Tak dá sa použiť to EVALUATE aj bez listu:
Sub pokus()
Dim Vysledok()
Vysledok = Evaluate("=GetA()&GetB()")
End Sub
Function GetA()
GetA = Array("a", "b", "c", "d")
End Function
Function GetB()
GetB = Array("m", "n", "o", "p")
End Function
Ide to aj na horizontálne aj vertikálne pole, ale ak by bolo potreba Transpose (či už v EVALUATE alebo v GetA), tak bude obmedzenie na počet 34464 prvkov. Samozrejmosťou je predpoklad rovnakých rozmerov polí.

Cyklus je ale rýchlostne nenahraditeľný, asi 10x rýchlejší. Takto som to testoval:
Dim arrA(), arrB()

Function SpojEvaluate() As Double
Dim Vysledok(), sta As Double, sto As Double
sta = Timer
Vysledok = Evaluate("=GetA()&GetB()")
sto = Timer
SpojEvaluate = sto - sta
End Function

Function GetA()
GetA = arrA
End Function

Function GetB()
GetB = arrB
End Function

Function SpojCyklus() As Double
Dim i As Long, u As Long, Vysledok(), sta As Double, sto As Double
sta = Timer
u = UBound(arrA)
ReDim Vysledok(1 To u)
For i = 1 To u
Vysledok(i) = arrA(i) & arrB(i)
Next i
sto = Timer
SpojCyklus = sto - sta
End Function

Sub VyplnPolia(u As Long)
Dim i As Long
ReDim arrA(1 To u): ReDim arrB(1 To u)
For i = 1 To u
arrA(i) = "A" & i: arrB(i) = "B" & i
Next i
End Sub

Sub Check()
Call VyplnPolia(100000) 'Počet prvkov polí
MsgBox ("Evaluate : " & SpojEvaluate & vbNewLine & "Cyklus : " & SpojCyklus)
End Sub

Jediné, čo ma napadlo bez cyklu je
1. krok prasknúť polia do listu (riadok pre každé pole, prípadné transponovanie v tom istom kroku)
2. cez EVALUATE spojiť stĺpce (výsledok bude pole)

Sub pokus()
Dim A(), B(), Vysledok()
A = Array("a", "b", "c", "d")
B = Array("m", "n", "o", "p")
Cells(1, 1).Resize(UBound(A) + 1) = WorksheetFunction.Transpose(A)
Cells(1, 2).Resize(UBound(B) + 1) = WorksheetFunction.Transpose(B)
Vysledok = Evaluate("=A1:A" & UBound(A) + 1 & "&B1:B" & UBound(B) + 1)
Cells(1, 3).Resize(UBound(A) + 1) = Vysledok
End Sub
Môžeme ale diskutovať, či nebude rýchlejšie to prehnať cez cyklus čisto v rámci VBA.

Tak len jednu k veci. AutoFit nefunguje pri zlúčených bunkách. Je potrebné dočasne použiť nejakú samostatnú bunku (kľudne na inom skrytom liste), ktorá bude mať šírku súčtu šírok zlúčených stĺpcov, a v nej urobiť AutoFit. A načítať potom novú výšku pre zlúčené riadky proporcionálne (teda ak sú zlúčené riadky o výškach 8 a 16, tak sa nová výška rozpočíta v pomere 1:2). Asi tak ...
Akurát že treba kontrolovať ktorá oblasť bola zmenená, a tú upravovať. No ak príde k výmazu, musí byť zase niekde uložená defaultná výška každého riadku (dvojriadku atď). Vidím to dosť komplikovane. Pri výmaze stránky to bude hardcore.

Nerozumiem teda, čo myslíte pod pojmom "upraviť kód". Ja by som to takto nerobil, ale toto je asi také nejaké podobné (aj s podobnými chybami ako neurčitý list, zbytočné Copy...):
Sub POKUS1()
Dim PoslRadek As Long
PoslRadek = Cells(Rows.Count, 2).End(xlUp).Row
Range("C5").FormulaR1C1 = "=SUMIFS(DATA!C[-1],DATA!C[-2],VYPOČET!RC[-1])"
Range("C5").AutoFill Destination:=Range("C5:C" & PoslRadek)
Range("C5:C" & PoslRadek).Copy
Range("C5:C" & PoslRadek).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
End Sub

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje