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

Příspěvky uživatele

??? Kedy ? Koho ? Koľko ? S kým ???
Ani z textu ani z prílohy žiaľ nerozumiem čo potrebujete.

V tej prílohe máte listy (Bydlení, Bydlení1, Bydlení2, Bydlení3), ktoré tam nechcete mať ?
Chcete mať iba nejaké združené údaje do jedného listu ? No tak ich ukladajte iba do jedného listu, nie do viacerých. Potom môžeme skúmať, čo ďalej potrebujete.
Tie spomínané listy sa štruktúrou nepodobajú, majú rozdielne členenie typu dát aj počtu stĺpcov.

Skúste ešte raz poslať inú prílohu, kde bude len to čo chcete mať (nie to čo máte a už tam nechcete). Pridajte tam aj hlavičky pre dáta, aby bolo jasné, čo je čo. Tam kde chcete mať nejaký výsledok (suma, počet, rozbaľovací zoznam) pridajte komentár, s tým čo tam požadujete.

Skúste, lebo skutočne nerozumiem...

Cez druhú inštanciu Excelu to pôjde isto, len to pár sekúnd trvá. Nedešifroval som, čo v tom makre robíte (neznáme premenné), tak som si podobné vymyslel.

Máte tam desatinné miesta, tak by som sa iba na jednu desatinu nespoliehal, ale pridajte tam x,000000000001.

EDIT: Prípadne ak ich máte takto zoradené:
=COUNTIF($B$2:$B$8;"<"&A14)

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.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse