Help excel\calc-funkce
Napsal: 17 črc 2009 11:31
od blauangel
zravim
potřeboval bych najit funkci s určitými vlastnostmy a to:
přesunout (skopírovat) nebo vytisknout řádek je li v určit buňce v tom řádku více než nula.
předem děkuji za návrhy
Re: Help excel\calc-funkce
Napsal: 17 črc 2009 15:53
od navstevnik
Bohuzel z principu to nemuze byt funkce listu, protoze funkce vraci hodnotu do bunky.
Resenim je udalostni procedura listu Worksheet_Calculate(), ktera prohleda sloupec s prislunou bunkou (pokud se jedna o vice radku) a vykona pozadovany presun nebo tisk.
Protoze je dotaz znacne obecny, neprikladam konkretni reseni. Mas-li zajem, upresni zadani - kde, rozhodovaci kriterium, zmena je vyvolana vlozenim hodnoty nebo zmenou funkcni hodnoty, presun kam nebo tisk,...
Re: Help excel\calc-funkce
Napsal: 21 črc 2009 16:56
od blauangel
děkuju za odpověd a skzusim to upřesnit
mam tabulku
jmeno, cena, kusů, cena dohromady,
a potřebuju skopírovat každý řádek ve kterém je víc kusů než nula
nevym jestli to stačí ale nevym co bych cem este napsal
Re: Help excel\calc-funkce
Napsal: 21 črc 2009 18:35
od navstevnik
reseni pro Excel:
na listu1 je hlavickovy radek (jmeno, cena, kusů, cena dohromady), radky splnujici podminku jsou presunuty na pomocny list a pak vytisknuty (jako nahled, zmen parametr v procedure) prostrednictvim nize uvedene procedury VBA (v editoru VBA - Alt+F11 - vloz do standardniho modulu), napr:
Kód: Vybrat vše
Option Explicit
Sub PresunATiskni()
Dim SBlok As Range, SCll As Range, TCll As Range, i As Long
' definice bloku bunek s poctem kusu
With Worksheets("list1")
Set SBlok = Intersect(.UsedRange, .Range("c:c"))
End With
'aktivace pomocneho listu list2
With Worksheets("list2")
' odstranit obsah na listu2
.UsedRange.EntireRow.Delete
' definice cile pro sestaveni tiskoveho listu
Set TCll = .Range("a1:d1")
i = 0
' vyhledavaci smycka
For Each SCll In SBlok.Cells
If SCll.Value > 0 Then
' preneseni radku splnujiciho podminku (i hlavickoveho)
TCll.Offset(i, 0).Value = SCll.Resize(1, 4).Offset(0, -2).Value
i = i + 1
End If
Next SCll
' vyber tabulky k tisku
.UsedRange.Columns.AutoFit
' zde je nastaveno nahled - Preview:=True, pro tisk na tiskarnu nastav Preview:=False
.UsedRange.PrintOut Copies:=1, Preview:=True, Collate:=True
End With
End Sub