Příspěvky uživatele

Taky moc nerozumím :-)
Na listu2 vyberu řádek, 2x kliknu a když už na daném řádku jsou hodnoty T-X, tak by se měly vyplnit hodnoty Y-AC? Ale vyplnit čím? Hodnotami z listu1 ze stejného řádku sloupce A-E, nebo F-J?

Chce to trochu srozumitelněji.

M@

nevím sice jak vypadá makro na uložení aktuálního dne do vlastního souboru, ale určitě by se toto makro dalo rozšířit, tak aby dané hodnoty zároveň zkopírovalo do nějakého měsíčního, ročního, nebo "nekonečného" souboru, buď excel, nebo nějaká databáze.
Otázkou může být proč se to rovnou netvoří jako další a další záznamy v jediné tabulce v jediném souboru, což by bylo nejsnažší, ale jelikož neznáme jak to vypadá, co se vyhodnocuje a jakým stylem se zadává, tak těžko soudit.

M@

nestačila by podmínka, tam co ti začíná kód "ULOŽÍ DATA NA LIST ŽELEZO" strčit podmínku na daný option a nakonci vkládání do daného listu ji ukončit viz níže:
'+++++ULOŽÍ DATA NA LIST ŽELEZO+++++++++++++++++++++++++++++++++++++++
If Op1.Value = True Then
Sheets("Železo").Select 'zvoli list železo
riadok = Cells(Rows.Count, 2).End(xlUp).Row + 1
Rem riadok = ActiveSheet.UsedRange.Rows.Count + 1
Cells(riadok, 4).Value = T2.Value '
Cells(riadok, 1).Value = txtDOTDate.Value
Cells(riadok, 5).Value = T3.Value
Cells(riadok, 6).Value = T4.Value
Cells(riadok, 7).Value = T5.Value
Cells(riadok, 8).Value = T6.Value
Cells(riadok, 9).Value = T7.Value
Cells(riadok, 10).Value = T8.Value
Rem Cells(riadok, 12).Value = T9.Value
Rem Cells(riadok, 15).Value = T10.Value
Rem Cells(riadok, 18).Value = T11.Value
Cells(riadok, 3).Value = T1.Value
Rem Cells(riadok, 13).Value = T13.Value
Cells(riadok, 12).Value = T14.Value
Cells(riadok, 13).Value = T15.Value
Rem Cells(riadok, 16).Value = T16.Value
Cells(riadok, 2).Value = C1.Value
Cells(riadok, 11).Value = C2.Value
Rem Cells(riadok, 14).Value = C3.Value
Rem Cells(riadok, 17).Value = C4.Value
End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
To samé pro druhý option a Barevné kovy.

M@

Pomocí funkce to nikdy nebude univerzální, šel bych na to raději makrem:
Public Sub najdi()
List2.Range("A6:J" & List2.UsedRange.Rows.Count + 5).ClearContents
Dim rd1 As Single
Dim rd2 As Single
Dim enid As String
rd2 = 6
enid = List2.Cells(2, 2)
For rd1 = 2 To List1.UsedRange.Rows.Count
If List1.Cells(rd1, 3) = enid Then
List2.Cells(rd2, 1) = List1.Cells(rd1, 2)
List2.Cells(rd2, 6) = List1.Cells(rd1, 1)
rd2 = rd2 + 1
End If
Next
End Sub

M@

Přiznám se že nevím co znamená to CDb1 :-), ale zkus tam dosadit něco jako:
Else: hodnota1 = Replace(UserForm2.C5.Value, ".", ",")
M@

Těžko říct jak kód vypadá, ale lepší než pracovat přímo s Combem je nejprve si hodnotu načíst do proměnné konkrétního typu, má-li být číslo, tak třeba single a pak dál v kódu pracovat s touto proměnnou. Dále pokud to místní nastavení OS vyžaduje, tak převést čárku na tečku replace(x,",",".").

M@

Možností jak to napsat je víc. Za předpokladu, že t1=A1 a t2 = B1
Nejsnažší je vyhodnotit každou hodnotu zvlášť a výsledek spojit (2 podmínky):
=KDYŽ(A1>0;"+";"-")&KDYŽ(B1>0;"+";"-")
ovšem aby to to odpovídalo danému algoritmu s třemi podmínkami, tak by to mělo vypadat asi takto:
=KDYŽ(A1>0;KDYŽ(B1>0;"++";"+-");KDYŽ(B1>0;"-+";"--"))
ale napsat to lze třeba i takhle:
=KDYŽ(A(A5>0;B5>0);"++";KDYŽ(A(A5<=0;B5<=0);"--";KDYŽ(A(A5>0;B5<=0);"+-";"-+")))
M@

řekl bych že hlavní problém je v tom, že máš zadáno 202 dní (Q1:Q202) a v grafu na dané ose mu pak říkáš, že těchto 202 dní = 52 týdnů, což je nesmysl, protože ti pak týden nevychází na 7 dní ale na 202 / 52 = necelé 4 dny.

Ale trochu se bojím, že ikdyž to nastavíš na 365 dní, že to nebude sedět úplně přeně, protože první týden nezačal prvního :-)

M@

pokusím se o teoretické nasměrování :-).
1) Přejmenuj si oblast (se stávajícím názvem mi to nejde), stačí třeba na "Q" ... pravým tlačítkem na oblast dat -> Vlastnosti Oblasti dat.
2) Vytvoř si makro jehož jediným řádkem bude:
List2.Cells(1, 1) = Range("Q").QueryTable.CommandTextčímž si do listu2 buňka A1 vypíšeš SQL dotaz.
3) V SQL dotazu si změň řádky:
SET @ucet = '501101'
SET @obdobi = 'U2012%'
na třeba:
SET @ucet = 'tmpucet'
SET @obdobi = 'tmpobdobi%'
4) Předchozí makro můžeš zrušit.
5) Vytvoř nové makro a do něj zadej:
Range("Q").QueryTable.CommandText = Replace(Replace(List2.Cells(1, 1), "tmpucet", List1.Range("J1")), "tmpobdobi", List1.Range("L1"))
Range("Q").QueryTable.Refresh6) Někde na listu1 si vytvoř tlačítko jenž se bude odkazovat na toto makro.
Je to neodzkoušená teorie, ale takhle nějak bych na to šel já :-).

M@

Ten kód jsem úplně přehlédl :-)

Sub Filtr()
Application.ScreenUpdating = False
Dim datum As Date
Dim datum_c As Date
Dim rd_vstup As Single
Dim rd_vystup As Single
Dim sl_vlastnost As Single
Dim sl_datum As Single
Dim sl_kriteria As Single
Dim sl_vysledek As Single
Dim sl_soucet As Single
Dim kod As String
Dim sl_kod As Single

datum = Range("G1")
kod = Range("H1")
sl_vlastnost = 1
sl_datum = 4
sl_kriteria = 7
sl_vysledek = 8
sl_soucet = 3
sl_kod = 2

rd_vystup = 2
Do While Cells(rd_vystup, sl_kriteria) <> ""
Cells(rd_vystup, sl_vysledek) = 0
rd_vystup = rd_vystup + 1
Loop

For rd_vstup = 2 To List1.UsedRange.Rows.Count
datum_c = Cells(rd_vstup, sl_datum)
If datum_c <= datum And kod = Cells(rd_vstup, sl_kod) Then
rd_vystup = 2
Do While Cells(rd_vystup, sl_kriteria) <> ""
If Cells(rd_vystup, sl_kriteria) = Cells(rd_vstup, sl_vlastnost) Then
Cells(rd_vystup, sl_vysledek) = Cells(rd_vystup, sl_vysledek) + Cells(rd_vstup, sl_soucet)
Exit Do
End If
rd_vystup = rd_vystup + 1
Loop
End If
Next
Application.ScreenUpdating = True
End Sub

M@

Můj stařičký excel 2003 na to nestačí, protože sumifs ještě nezná, ale dá se to obejít komplet makrem.
Jen u tvého příkladu mi není jasné proč máš výsledek 719, když kritérium data je je menší nebo rovno 29.1.2013. s vlastností vl1 jsou tam dva výskyty (5.1.2012 a 29.1.2013) což obojí splňuje podmínku, takže výsledek = 124 + 719. Teda pokud to dobře chápu :-).
Tady je jeden příklad:
Sub Filtr()
Application.ScreenUpdating = False
Dim datum As Date
Dim datum_c As Date
Dim rd_vstup As Single
Dim rd_vystup As Single
Dim sl_vlastnost As Single
Dim sl_datum As Single
Dim sl_kriteria As Single
Dim sl_vysledek As Single
Dim sl_soucet As Single

datum = Range("G1")
sl_vlastnost = 1
sl_datum = 4
sl_kriteria = 7
sl_vysledek = 8
sl_soucet = 3

rd_vystup = 2
Do While Cells(rd_vystup, sl_kriteria) <> ""
Cells(rd_vystup, sl_vysledek) = 0
rd_vystup = rd_vystup + 1
Loop

For rd_vstup = 2 To List1.UsedRange.Rows.Count
datum_c = Cells(rd_vstup, sl_datum)
If datum_c <= datum Then
rd_vystup = 2
Do While Cells(rd_vystup, sl_kriteria) <> ""
If Cells(rd_vystup, sl_kriteria) = Cells(rd_vstup, sl_vlastnost) Then
Cells(rd_vystup, sl_vysledek) = Cells(rd_vystup, sl_vysledek) + Cells(rd_vstup, sl_soucet)
Exit Do
End If
rd_vystup = rd_vystup + 1
Loop
End If
Next
Application.ScreenUpdating = True
End Sub

M@

Pokud zadané datum bude vždy pondělí, pak by to mělo jít jednoduše rozdílem dvou datumů, zadané datum - 1.1. stejného roku jako je zadané datum, buňku to standartně zobrazí jako datum, ale stačí je formátu buňky změnit na číslo.
=C4-DATUM(ROK(C4);1;1)+1

M@

Aby se to automaticky řadilo, tak to vzorce nepůjde, ale aby se tvořila jakási sloučenina, tak zkus do C1 zadat:
=KDYŽ(A1<>"";A1;KDYŽ(INDEX(B:B;COUNTIF($A$1:A1;""))<>"";INDEX(B:B;COUNTIF($A$1:A1;""));""))

a tento roztáhnout.
Pokud to má ale něco dělat automaticky, tak pak jedině makrem.

M@

Ale jo, tak s něčím už jsme se setkali, ale s přílohou to nebylo :-).

Public Sub vytvor()
For i = 1 To List1.UsedRange.Rows.Count
Sheets.Add.Name = List1.Cells(i, 1)
List1.Hyperlinks.Add Anchor:=List1.Cells(i, 1), Address:="", SubAddress:="'" & List1.Cells(i, 1) & "'!A1", TextToDisplay:=List1.Cells(i, 1).Value
With List1.Cells(i, 1).Font
.Name = "Arial"
.Size = 8
.Bold = True
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Next
List1.Activate
End Sub

M@

Ahoj,

máte někdo kombinaci Win7 a Office 2003?
Nevím proč, ale z nějakého důvodu, když např. v excelu (klidně i v powerpointu) vytvořím nějaký soubor, pak přímo v něm dám Soubor -> Odeslat -> Příjemce pošty (jako příloha)... . Klasicky se otevře okno outlooku se zprávou s vloženou přílohou, ale ejhle při kliknutí na tlačítko odeslat se nic neděje. S Win XP fungovalo, naštěstí i ve Win7 se to dá obejít stiskem klávesové zkratky Ctrl+Enter, ale kdyby měl někdo nějaký návod jak to opravit, tak bych se určitě nezlobil :-).
Nevím jestli teda je-li to obecný problém kombinace Win7 s Office 2003, nebo jen můj :-)

Díky
M@

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje