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

Příspěvky uživatele

Pr.:
Sub VymazBunkyObsahujuce(Co As String, Stlpec As Long)
Dim Riadkov, Data(), i As Long, RNG As Range
With ActiveSheet
Riadkov = .Cells(Rows.Count, Stlpec).End(xlUp).Row
ReDim Data(1 To Riadkov, 1 To 1)
If Riadkov = 1 Then Data(1, 1) = .Cells(1, Stlpec).Value2 Else Data = .Cells(1, Stlpec).Resize(Riadkov).Value2
For i = 1 To Riadkov
If InStr(1, Data(i, 1), Co, vbTextCompare) > 0 Then
If RNG Is Nothing Then Set RNG = .Cells(i, Stlpec) Else Set RNG = Union(RNG, .Cells(i, Stlpec))
End If
Next i
If Not RNG Is Nothing Then RNG.Delete Shift:=xlUp: Set RNG = Nothing
End With
End Sub

Sub Pokus()
Call VymazBunkyObsahujuce("bla", 1)
Call VymazBunkyObsahujuce("s.r.o", 2)
End Sub

Na Googli som rýchlo našiel nejaké súvislé témy
http://www.vbaexpress.com/kb/getarticle.php?kb_id=267
http://www.vbaexpress.com/kb/getarticle.php?kb_id=272
https://stackoverflow.com/questions/40958650/use-vba-to-automatically-add-vbproject-references-to-powerpoint-library-depende

A mnohé ďalšie...

No tak skúste toto, Jednouché to veru nieje.

Pr.

-Tá šablóna musí byť externá (iný súbor na disku) ? Alebo môže byť súčasťou tohto zošitu ?
-Makro sa bude spúšťať z iného zošitu, a v tomto sa budú pridávať iba listy, ale inak bude tento súbor bez makra ? Alebo bude makro v tomto zošite ?
-Môže nastať, že bude treba zapísať viac riadkov ako 31 (toľko má šablóna riadkov v častiach 5,6,7) ? Alebo aj v iných častiach či môže nastať "pretečenie" ? Čo v takom prípade ?
-Časti 1,2,3,4,8,9 sú vždy jednočlenné, alebo môžu byť viacčlenné ?
-Časti 1,2,3,4 vždy začínajú danú skupinu pre jeden list ? Teda sú vždy na prvom riadku skupiny ?
-Časti 8,9, sú vždy na konci skupiny ?
...

Domov - Úpravy - Vymazať - Vymazať formáty

Stiahnuť to ale veru nejde. Veľkosť 0.

s = Replace(s, "_", "", 1, 1)
Prečo by to nefungovalo ?

EDIT: Ešte prikladám aj súbor, kde je ukázaný príklad hromadného načítania aj zápisu, lebo po jednej bunke to robiť = pomalé.

Toto by malo fungovať...
Function ZoznamSuborov(Adresar As String) As Variant
Dim FSO As Object, Subor As Object, Zoznam() As String, Pocet As Long

On Error GoTo KONIEC
Set FSO = CreateObject("Scripting.FileSystemObject").GetFolder(Adresar)
On Error GoTo 0

Pocet = FSO.Files.Count
If Pocet > 0 Then
ReDim Zoznam(1 To Pocet)
Pocet = 0
For Each Subor In FSO.Files
Pocet = Pocet + 1
Zoznam(Pocet) = Subor.Name
Next Subor
ZoznamSuborov = Zoznam
End If

KONIEC:
Set FSO = Nothing: Set Subor = Nothing
End Function


Sub pokus()
Dim Vysledok
Vysledok = ZoznamSuborov("\\Elnino-pc\Download D\")
If IsArray(Vysledok) Then
ActiveSheet.Cells(1, 1).Resize(UBound(Vysledok)).Value2 = Application.Transpose(Vysledok)
Else
MsgBox ("Niesú žiadne súbory")
End If
End Sub

Private Sub Worksheet_Activate()
Worksheets("Hárok2").Cells(1, 1).Value = "Je zobrazený Hárok1"
End Sub

Private Sub Worksheet_Deactivate()
Worksheets("Hárok2").Cells(1, 1).Value = ""
End Sub

Pracovnú dobu môžete do konštanty zapísať ako Date:
Const PracDob1 = #8:00:00 AM#
alebo ako Double :
Const PracDob2 = 1 / 3

Sviatky môžete do poľa zadať :
Dim Svatky(), Rok As Long
Rok = Year(Date)
Svatky = Array(DateSerial(Rok, 1, 1), CDate(Evaluate("=(DOLLAR((""4/""&" & Rok & ")/7+MOD(19*MOD(" & Rok & ",19)-7,30)*14%,)*7-6)+1")), DateSerial(Rok, 5, 1), DateSerial(Rok, 5, 8), DateSerial(Rok, 7, 5), DateSerial(Rok, 7, 6), DateSerial(Rok, 9, 28), DateSerial(Rok, 10, 28), DateSerial(Rok, 11, 17), DateSerial(Rok, 12, 24), DateSerial(Rok, 12, 25), DateSerial(Rok, 12, 26))
ale ako pozerám na tému, tak na koniec ešte pridajte 1.1.Rok+1, ak by náhodou incident nastal na konci roka, treba počítať aj so sviatkom 1.1. následujúceho roku.

Detto by som doplnil aj pre ten vzorec od marjankaj. Označiť E4, vytvoriť Definovaný názov SVATKY:
=DATEVALUE(MID(SUBSTITUTE("01.01.XXXX"&TEXT((DOLLAR(("4/"&YEAR(List1!$C4))/7+MOD(19*MOD(YEAR(List1!$C4);19)-7;30)*14%;)*7-6)+1;"dd.mm.")&"XXXX01.05.XXXX08.05.XXXX05.07.XXXX06.07.XXXX28.09.XXXX28.10.XXXX17.11.XXXX24.12.XXXX25.12.XXXX26.12.XXXX01.01."&YEAR(List1!$C4+1);"XXXX";YEAR(List1!$C4));{1;11;21;31;41;51;61;71;81;91;101;111;121};10))
=DATUMHODN(ČÁST(DOSADIT("01.01.XXXX"&HODNOTA.NA.TEXT((KČ(("4/"&ROK(List1!$C4))/7+MOD(19*MOD(ROK(List1!$C4);19)-7;30)*14%;)*7-6)+1;"dd.mm.")&"XXXX01.05.XXXX08.05.XXXX05.07.XXXX06.07.XXXX28.09.XXXX28.10.XXXX17.11.XXXX24.12.XXXX25.12.XXXX26.12.XXXX01.01."&ROK(List1!$C4+1);"XXXX";ROK(List1!$C4));{1;11;21;31;41;51;61;71;81;91;101;111;121};10))
,ktorý bude počítaný automaticky pre každý riadok, teda incidenty môžu byť v rôznych rokoch. Inak by sa totiž pre predmetné roky museli robiť vždy samostatné stĺpce s dátumami pre daný rok.

A ten marjankaj-ov vzorec iba doplniť o tie počítané sviatky, čiže:
=WORKDAY(C4;INT((B4+D4*24)/8)-1;SVATKY)+MOD(B4+D4*24;8)/24+1/3
=WORKDAY(C4;CELÁ.ČÁST((B4+D4*24)/8)-1;SVATKY)+MOD(B4+D4*24;8)/24+1/3

Pr.

Ja som z tých podmienok trochu pomotaný, ale skúste toto. Uvádzam len ako príklad na to aby som ja pochopil logiku :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

For i = 1 To 10
If InStr(Cells(i, 2).Value, "2018") > 0 Then
Cells(i, 3).Value = "OK"
Else
If InStr(Cells(i, 4), "cvt") > 0 Then
Cells(i, 2) = Cells(i, 2) & "/2018"
Cells(i, 3).Value = "OK"
Else
Cells(i, 3).Value = ""
End If
End If
Next i
End Sub
Každopádne, o koľko ide reálne dát ? Je nevhodné to robiť bunku po bunke na väčšom množstve dát - bude to pomalé. Navyše po každom označení bunky? To by bolo lepšie po každej zmene bunky, nie po označení, s tým že by sa na začiatok a koniec vypli/zapli Application.EnableEvents=False (True).
Ten cyklus má mať vždy 10 riadkov ?
OK sa má napísať vždy keď B obsahuje 2018, bez ohľadu na to či je v D hodnota "cvt" alebo nie ?

Šmarjá zase popis bez prílohy, a zase nejednoznačne pochopiteľný. Bez prílohy výstrel na slepo :
COUNTIF
SUMIF
MATCH / POZVYHLEDAT
VLOOKUP / SVYHLEDAT

Neviem ako presne kooperuje aplikačná vrstva kompilátoru VBA s OS a CPU, ale ak je tam skutočne nejaký tzv. špekulatívny výpočet (prediktívny), tak je slušná šanca, že to urobí aj za zobrazením Formulára, aj keď sa o tom nedozviete, ani keď si dáte Breakpoint. Treba vyskúšať, a ak to bude OK tak to bude asi kratšia cesta ako hľadať ťažko dostupné riešenie nepravidelného a ťažko odchytiteľného problému.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse