Áno, už som to tiež písal vyššie. Parameter v EVALUATE/VYHODNOTIT je text.
@Alfan: nemôžete priložiť nejakú anonymizovanú prílohu? Lepšie by sme to dokázali implementovať na nej. Nech je vidno čo je Tabuľka, kde sú texty (vzorce), čo treba pridať (odkaz na Tabuľku/list do textu vzorca) ...
nevysomári - nevyzná sa, neporozumie, je z toho somár
Nemôžete použiť
[@trip]
nezabúdajte, že je to textový reťazec, a on nevie o akú ide Tabuľku. Musíte použiť
tblPokus[@trip]
A to vyskúšanie jednoduchých vzorcov som myslel presne ako som napísal. Neskúšajte to VYHODNOTIT rozchodiť na polmetrovom vzorci využívajúcom pokročilé funkcie, ale na jednoduchom KDYŽ ako som napísal.
Samozrejme, zabudol som na preklad :)
Skúste dať preč
"="&
vraj to má byť text bez "=", mne to fičí s ním aj bez neho.
EDIT:
Nechce sa mi to overovať, tak to prehodím na Vás. Overte ďalej, či EVALUATE/VYHODNOTIT pozná CZ vzorce.
A určite sa nevysomári mimo Tabuľky z tohto
[@trip]
Potom skúste iba jednoduchý vzorec, napr.
KDYŽ(1=1;1+2;5+5)
, žiadne TYP, JE.CHYBHODN, SVYHLEDAT a pod.
Vytvorte si Definovaný názov napr. "PROVEST_VZOREC"
=EVALUATE("="&List1!$A$8)
=VYHODNOTIT("="&List1!$A$8)
a potom do C2 dajte
=IF(A2=2;PROVEST_VZOREC;4444)
=KDYŽ(A2=2;PROVEST_VZOREC;4444)
Ak pri otváraní zošitu pridáte do zabezpečenia parameter UserInterfaceOnly, zmena makrom nebude vyžadovať odomknutie, a všetko môže byť zamknuté, no nemôže byť prepojená bunka:
Private Sub Workbook_Open()
Worksheets("List1").Protect Password:="", UserInterfaceOnly:=True
End Sub
V liste potom stačí
Private Sub CheckBox1_Click()
Range("B2").Value = CheckBox1.Value
End Sub
Ak chcete prepojenú bunku, môžete ju nalinkovať do skrytého listu, nemusí byť v tom liste a zavadzať. Ten list ale bude skrytý nastavením vlastnosti
Visible = xlSheetVeryHidden
Teda nebude dostupné jeho odkrytie štandardným spôsobom, ale iba vo VBA. Potom nepotrebujete vyššie uvedené 2 kódy.
A to VBA zabezpečte tiež heslom. Aby sa nedal odokryť list, ani aby nebolo vidieť heslo vo Workbook_Open.
Tools - VBAProject Properties - Protection - Lock project for viewing + heslo
Ale zabezpečenie Excelu neberte ako nedobytné, to je skôr na zabránenie nechcenému dodrbkaniu dát, ako na zabezpečenie pred "hackerom" :)
Do modulu ThisWorkbook
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Sh.Name <> "Vstup" Then
Dim Bunka As Range, Riadok(), bPodmienka As Boolean
On Error Resume Next
Set Bunka = Intersect(Target, Sh.Range("C2:C11")).Cells(1)
If Err.Number = 0 Then
Cancel = True
Application.EnableEvents = False
If Bunka = ChrW(10004) Then
Bunka = ""
Else
Riadok = Bunka.Offset(0, -2).Resize(, 4).Value
bPodmienka = (Not IsEmpty(Riadok(1, 1)) And IsNumeric(Riadok(1, 1))) And (Not IsEmpty(Riadok(1, 2)) And IsNumeric(Riadok(1, 2))) And Riadok(1, 2) >= Range("hodnmin") And (Not IsNumeric(Riadok(1, 4)) Or IsEmpty(Riadok(1, 4)))
Bunka = IIf(bPodmienka, ChrW(10004), "")
End If
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Vstup" Then
Dim Zmena As Range, ARE As Range, OK As Range, NOK As Range, Riadky(), r As Long, hodnmin As Double
Set Zmena = Intersect(Target, Sh.Range("A2:B11,D2:D11"))
If Not Zmena Is Nothing Then
Set Zmena = Intersect(Zmena.EntireRow, Sh.Range("A2:D11"))
hodnmin = Range("hodnmin")
For Each ARE In Zmena.Areas
Riadky = ARE.Value
For r = 1 To UBound(Riadky, 1)
If Riadky(r, 3) <> "" Then
Select Case (Not IsEmpty(Riadky(1, 1)) And IsNumeric(Riadky(1, 1))) And (Not IsEmpty(Riadky(1, 2)) And IsNumeric(Riadky(1, 2))) And Riadky(r, 2) >= hodnmin And (Not IsNumeric(Riadky(r, 4)) Or IsEmpty(Riadky(1, 4)))
Case True: If OK Is Nothing Then Set OK = ARE.Cells(r, 3) Else Set OK = Union(OK, ARE.Cells(r, 3))
Case False: If NOK Is Nothing Then Set NOK = ARE.Cells(r, 3) Else Set NOK = Union(NOK, ARE.Cells(r, 3))
End Select
End If
Next r
Next ARE
Application.EnableEvents = False
If Not OK Is Nothing Then OK.Value = ChrW(10004)
If Not NOK Is Nothing Then NOK.Value = ""
Application.EnableEvents = True
End If
End If
End Sub
EDIT:
Pridal som aj reakciu na to, ak zmeníte A/B na nečíslo alebo D na číslo, prípadne zmažete - fajka zareaguje. Lebo môžete urobiť zmenu dát, ktoré stáli predtým za schválením fajky...
Které by před kopírováním dat na jiný list omezilo oblast kopírovaných dat podle týdnu.
Tu máte iba jednoduchú úpravu, ale už minule som Vám písal, že tam môže nastať množstvo problémov (nechtiac). Filter, nesúlad medzi týždňami, prázdne bunky, nečíselné data (to máte aj teraz)... Ja som začal upravovať aj ten Váš predošlý súbor, no nedokončil. Zatiaľ.
Napr. do D2 a potiahnuť dole (ak to chcete do B, tak vo vzorci zmeniť "D1" na "B1"):=IF(AND(A3="MERGE-IN";A2="MERGE-OUT");"staré isn";IF(D1="staré isn";"nové isn";""))
=KDYŽ(A(A3="MERGE-IN";A2="MERGE-OUT");"staré isn";KDYŽ(D1="staré isn";"nové isn";""))
Ešte ma napadlo jedno riešenie
With Worksheets("Hárok1")
Intersect(.Range("B:B,D:F,J:J,N:Q,DK:DK,DM:DM,DQ:DU,DV:EB,FK:FN,FP:FP,FS:FS,FU:FY,QM:QP,QQ:QU,QV:RF,RG:RP,RQ:SG,SH:SM,SR:SS"), .Cells.Resize(Rows.Count - 1).Offset(1, 0)).ClearContents
End With
Operáciu mazania vykonáte naraz, len tú adresu oblasti rozdelíte na 2 reťazce, teda 2 Range, no naspäť spojené v Union, tak ako som ukázal.
A neviem, čo bude všetko to makro ešte robiť, ale Select nemusíte použiť vôbec, ani tie Scroll. Ideálne by bolo aj označenie listu, aby nedošlo k spusteniu makra na inom liste. Stačí teda iba:
With Worksheets("nazov listu")
Union(.Range("prvá polka textu adresy"), .Range("druhá polka textu adresy")).ClearContents
End With
Dĺžka adresy môže byť maximálne veľkosť datového typu Byte, teda 0..255. Vaša adresa má 257 znakov.
Dajte si to na menšie kúsky a do Union
Union(Range("B2:B1048576,D2:F1048576,J2:J1048576,N2:Q1048576,DK2:DK1048576,DM2:DM1048576,DQ2:DU1048576,DV2:EB1048576,FK2:FN1048576,FP2:FP1048576"), _
Range("FS2:FS1048576,FU2:FY1048576,QM2:QP1048576,QQ2:QU1048576,QV2:RF1048576,RG2:RP1048576,RQ2:SG1048576,SH2:SM1048576,SR2:SS1048576")).Select
To je parádny nápad, ako obabrať obmedzenie celých čísel v RANDBETWEEN zároveň s ROUND a zároveň so zahrnutím limitných hodnôt
Ale nezabudnite ešte na "balast" - teda kontrolu. Či bolo zadané číslo, či nebol InputBox zrušený, pozor ak máte filtrované dáta - vtedy zisťovanie posledného riadku metódou "xlUp" nefunguje a treba použiť Find, no a nechce sa mi moc premýšľať, ale neviem či netreba pripočítať +0,1 niekde v "(Maximum - Minimum + 0,1)" aby bola dosiahnuteľná aj horná hranica, ...
Možno ešte jednoduchšie:
Sub zapisvzorec5()
Dim Radku As Long
Dim Minimum As String, Maximum As String
Minimum = Replace(InputBox("Zadej minimální hodnotu např: 5,7 "), ",", ".")
Maximum = Replace(InputBox("Zadej maximální hodnotu např: 7,2 "), ",", ".")
With Worksheets("vysledky")
Radku = .Cells(Rows.Count, "A").End(xlUp).Row - 1
.Range("B2").Resize(Radku).Value = Evaluate("=ROUND(RANDARRAY(" & Radku & ",1," & Minimum & "," & Maximum & ",FALSE),1)")
End With
End Sub
RandArray() by sa dalo použiť aj v tom cykle:
Sub zapisvzorec4()
Dim Radku As Long
Dim Minimum As Double, Maximum As Double
Dim R()
Minimum = Val(Replace(InputBox("Zadej minimální hodnotu např: 5,7 "), ",", "."))
Maximum = Val(Replace(InputBox("Zadej maximální hodnotu např: 7,2 "), ",", "."))
With Worksheets("vysledky")
Radku = .Cells(Rows.Count, "A").End(xlUp).Row - 1
R = WorksheetFunction.RandArray(Radku, 1, Minimum, Maximum, False)
For i = 1 To Radku
R(i, 1) = Round(R(i, 1), 1)
Next i
.Range("B2").Resize(Radku).Value = R
End With
End Sub
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.