Příspěvky uživatele

Keď na to ešte tak pozerám, pridajte na koniec tohto riadku:
If Z = False Then Col.Add Array(Datum, i)
ešte ", CStr(i)", teda:
If Z = False Then Col.Add Array(Datum, i), CStr(i)

Možno aj takto, ale pozor, používa sa rovnako veľká oblasť vpravo, kde sa premiestnia zoradené oblasti, a pôvodné stĺpce (už bez oblastí) sa celé zmažú. Vyskúšajte.

Sub ZoradSkupiny()
Dim Col As Collection, Riadkov As Long, Skupin As Long, i As Long, c, Datum As Date, Dat(), Z As Boolean, OldRng As String

Set Col = New Collection
With ThisWorkbook.ActiveSheet
Riadkov = .Cells(Rows.Count, 2).End(xlUp).Row + 2
Skupin = Riadkov \ 9
If Riadkov / 9 <> Skupin Then MsgBox "Oblasti niesú rovnomerné! Koniec.": Exit Sub
ReDim Dat(1 To Riadkov, 1 To 1)
Dat = .Cells(1, 12).Resize(Riadkov).Value

For i = 1 To Skupin
Datum = Dat((i - 1) * 9 + 3, 1)
Z = False
If Col.Count > 0 Then
For Each c In Col
If c(0) > Datum Then Col.Add Array(Datum, i), Before:=CStr(c(1)): Z = True: Exit For
Next c
If Z = False Then Col.Add Array(Datum, i), CStr(i)
Else
Col.Add Array(Datum, i), CStr(i)
End If
Next i

With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual: End With
OldRng = Selection.Address
.Cells(1, 1).Resize(, 13).Copy
.Cells(1, 14).Resize(, 13).PasteSpecial Paste:=xlPasteColumnWidths

Riadkov = 0
For Each c In Col
.Cells((c(1) - 1) * 9 + 1, 1).Resize(9, 13).Cut
.Cells(Riadkov * 9 + 1, 14).Resize(9, 13).Insert Shift:=xlDown
Riadkov = Riadkov + 1
Next c

.Columns(1).Resize(, 13).EntireColumn.Delete

With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic: End With
.Range(OldRng).Select
End With

Set Col = Nothing
End Sub

Tak?

Dnes v každej vete čo prečítam vidím nelogickosť.
"odoslalo na gmail bez outloku" ??? Každý mail predsa odosiela maily na akýkoľvek mail, nie len na gmail. Asi myslíte "odoslalo z gmailu bez outloku". A to je povedané niečo úplne iné. Na to sa používa metóda CDO, ale pri nej musia byť v makre uložené prihlasovacie údaje do mailu (hocikto ich môže vidieť, heslo tomu príliš nezabráni). Zadajte si tu na fóre hľadať výraz "CDO", je tu príkladov hafo. Marí sa mi tuším dokonca, že niekto spomínal, že cez vlastný poštový server heslo netreba. Neverím, že to tu za 20 min nenájdete.

Skutočne nejde použiť Worksheet_Change a chcete použiť Worksheet_Calculate ? Skúste z týchto 2 príkladov prísť na to aké to môže prinášať komplikácie (iba napoviem, že v Calculate sa nedozviete, čo spôsobilo prepočet, ani či vôbec došlo k zmene danej bunky ...).
A Vy máte dať prílohu + presný popis čo sa má diať, nie ja.

Toto bude fungovať aj pri prepočítaní vzorcov, nielen pri zmene nejakej bunky (pri nej tiež).

Do VBA listu:
Private Sub Worksheet_Calculate()
If Cells(1, 1).Value > 0.5 Then MojeMakro
End Sub

Do VBA listu alebo modulu:
Sub MojeMakro()
...
End Sub

A to je konštatovanie, či otázka ?
V oboch prípadoch - áno, funguje to na každý mail, ktorý je nastavený v Outlooku.

"Palooo" je užívateľ, ktorý pridal v prvom príspevku odkaz na riešenie, a v treťom príspevku odkaz na súbor s príkladom v prílohe. A potom nasleduje ďalší príklad od užívateľa "dream2003" formou zobrazeného textu. Všetky tieto menované príspevky obsahujú nejaký kód. Nenapísal ste, na ktorý príklad sa pýtate. Preto som písal, či chcete aby som pozrel aj na ten príklad od užívateľa "Palooo".

Bez skúšania....
.to = ""
-->>
.to = ThisWorkbook.Worksheets("meno listu s mailom").Range("adresa bunky s mailom").Value

Mám Vám pozrieť, kde to nastaviť aj vo verzii od Palooo ?

=IF(COUNTIF(Svátky!$C$3:$C$28;J3)>0;1;"")
=KDYŽ(COUNTIF(Svátky!$C$3:$C$28;J3)>0;1;"")
alebo
=IF(ISERROR(MATCH(J3;Svátky!$C$3:$C$28;0));"";1)
=KDYŽ(JE.CHYBHODN(POZVYHLEDAT(J3;Svátky!$C$3:$C$28;0));"";1)

=IF(A2<>"";IF(ROW(A2)=2;TEXT(A2;"d.m.")&YEAR(A2);IF(B1<>"";B1&",";B1)&TEXT(A2;"d.m.")&YEAR(A2));IF(ROW(A2)=2;"";B1))

=KDYŽ(A2<>"";KDYŽ(ŘÁDEK(A2)=2;HODNOTA.NA.TEXT(A2;"d.m.")&ROK(A2);IF(B1<>"";B1&",";B1)&HODNOTA.NA.TEXT(A2;"d.m.")&ROK(A2));KDYŽ(ŘÁDEK(A2)=2;"";B1))

TEXT(A2;"d.m.")&YEAR(A2)
som použil namiesto
TEXT(A2;"d.m.yyyy")
lebo by to pri prechode SK(EN) -> CZ nefachalo, kvôli tomu ž v CZ je to
TEXT(A2;"d.m.rrrr")
ale automaticky sa to nemení.

Nedobré riešenie dizajnu. Tabuľka zdrojových dát by mohla byť spojitá, dáta na jednom liste, výstupy na inom. Dátumy majú byť dátumy a nie text, čísla majú byť čísla. Identifikácia roku by mohla byť jednoznačnejšia (takto treba zisťovať každý 7-mi riadok v O:O), v samostatnom stĺpci a nie v stĺpci spolu s dátami. Počítať "predd" a "rozdiel" v inom roku ako v tom, ktorý má v "Plány ročné" vstupné údaje, je nezmysel. Predpokladám, že to chcete používať tak, že skopírujete jeden rok, a vložíte za posledný a pred výstup - viď 2. veta.

Na požiadanie úprava/oprava verzie 30965_kopirovanie-listov-subor-subor.zip z 1.4.2016 14:26 (končilo chybou pri nevybratí súboru).

Označte bunky - Údaje - Text na stĺpce - Ďalej - Tabulátor, Ďalej - Všeobecné, Spresniť - Znamienko mínus za záporným číslom - OK - Dokončiť.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje