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

Příspěvky uživatele

Dobré by bolo priložiť prílohu. Takto som si musel vyrábať tú Vašu tabuľku podľa obrázku, a aj tak som nerozoznal čo tam tam na obrázku napr je v poslednom stĺpci, alebo počet hodín za zmenu (???). Počítanie napr. takto:

Datum1.xlsm - iba zmeníte hodnotu dátumu v A1 na liste A, a samé to skopíruje hodnoty na dané miesta.
Datum2.xlsm - hodnoty na dané miesta to skopíruje až po stlačení tlačidla.

Ak tam to Overenie dát v reále je, tak to fungovať bude, lebo nastane zmena uživateľom v bunke. Ale ak tam to Overenie je len teraz pre skúšku makra, a v skutočnosti tam bude vzorec, ako píše, tak sa OnChange vzorcom nevyvolá.

Vy už na toto žiadne makro vytvárať nemusíte. V prílohe som Vám poslal upravený súbor (ktorý ste poslal Vy), v ktorom som to testoval, ale iba na jednom vyplnenom riadku.
Takže:
-zmenil som Vám tabuľku na Tabuľku - tá si totiž vzorce, formátovanie, overenie kopíruje sama po vložení nových dát pod ňu.
-nastavil som Vám teda overovanie ANO/NE na celú oblasť, ktorú ste spomínal.
-vyplnil som 4 riadky v oblasti ANO/NE
-a teraz mi povedzte, že nevidíte na liste "1.SL" žiadnu zmenu, keď do danej bunky Seznam!H1 napíšete 1, a potom napr 3.

EDIT: SZ môžete, samozrejme. Zajtra budem ale celý deň mimo SR, tak riešiť to môžme teraz ešte max hodku, potom až pozajtra. Viem, že Vám to ponáhľa, možno niekto iný by sa do toho zajtra obul.

Vyskúšajte, či som Vás pochopil správne. Na červenú oblasť som Vám doplnil Overenie dát (ANO, NE), a na skrývanie riadkov je makro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Riadok As Long, i As Integer, RNG As Range
If Not Intersect(Target, Cells(1, 8)) Is Nothing Then
On Error Resume Next
Riadok = WorksheetFunction.Match(Cells(1, 8), Columns(1), 0)
If Err = 0 Then
With Worksheets("1.SL")
For i = 1 To 17
If Cells(Riadok, 21 + i) = "NE" Then
If RNG Is Nothing Then Set RNG = .Cells(17 + i, 2) Else Set RNG = Union(RNG, .Cells(17 + i, 2))
End If
Next i
.Cells(18, 2).Resize(17).EntireRow.Hidden = False
If Not RNG Is Nothing Then RNG.EntireRow.Hidden = True
End With
Else
MsgBox ("Neregulérní hodnota řádku.")
Application.Undo
End If
End If
End Sub

Pred chvíľou som nad tým rozmýšľal presne rovnako, ako píšete. Veď to by malo byť principiálne úplne jedno. Tým pádom, je to warez, a to by sa tu riešiť nemalo.

Takže týmto ďakujem AL-ovi za usmernenie, a verejne prehodnocujem svoju snahu "pomôcť" Petr_07. Takže nie.

Áno, váhal som. A v SZ som dotyčnému uviedol, že ak to bude čokoľvek od vývojárov z tohto fóra tak do toho nejdem, a iné si ešte rozmyslím. Ale súhlasím s Vami, uvidím či mi príde nejaký súbor, a čo to bude ... rozhodnem sa následne.

Čo, kde, koho, kedy, kam ???
Absolútne netuším "wo co tady go". Prosím urobte ešte jednu prílohu, kde vyfarbíte na červeno, čo chcete kde zmeniť a na akú hodnotu, a na zeleno vyfarbíte čo by sa malo kde všade zobraziť. Lebo sa fakt v popise strácam.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RZdroj As Long, RCiel As Long, D As Date, Nazvy, i As Integer
If Not Intersect(Target, Cells(1, 1)) Is Nothing Then
D = Cells(1, 1): Nazvy = Array("X", "Y", "Z")
On Error Resume Next
For i = LBound(Nazvy) To UBound(Nazvy)
With Worksheets(Nazvy(i))
RZdroj = WorksheetFunction.Match(Nazvy(i), Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row), 0)
RCiel = WorksheetFunction.Match(CLng(D), .Cells(1, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row).Value2, 0)
If Err = 0 Then .Cells(RCiel, 2).Resize(1, 6).Value = Cells(RZdroj, 2).Resize(1, 6).Value Else Err.Clear
End With
Next i
End If
End Sub

Skúste

Urobte zo svojho súboru jednoduchú kópiu, s pár riadkami v každom liste, citlivé firemné info nahradte somarinami, a pošlite nám prílohu (zabaliť do ZIP/RAR). Určite Vám niekto skôr pomôže, ak si nebude musieť vymýšľať štruktúru dát, a následne ju po piatich konzultáciách úplne prekopávať...

SZ

Ten Váš príklad aj tak nedáva zmysel. To Vám stačí len vypísať pomocou COUNTIF počet výskytov, a nie (stále tie isté) vypisovať, daný počet krát. Skôr ma napadá druhá metóda. Kontrola obsahu bunky na hodnotu. Viď posledná pridaná položka v hodnotách a druhá metóda.

Prílohu musíte zabaliť do formátu ZIP alebo RAR, inak Vám ju nezoberie. Alebo iba za názov súboru na koniec za príponu ".XLSX" pripíšte ".ZIP", ale dopredu na to upozornite :)

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje