Příspěvky uživatele
< návrat zpět
pokiaľ by som to riešil ja, tak by som použil kontingenčnú tabuľku
Spôsobov existuje niekoľko, ničmenej, sám používam niečo podobné, kedy dnešný dátum pridávam k záznamu, ktorý tvorím, dátum sa mi zapisuje do stĺpca H v riadku, do ktorého zapíšem v stĺpci A nejakú hodnotu. Keď, tak si to douprav - kód je potrebné vložiť do kódového okna listu, v ktorom to cheš používať:
Private Sub Worksheet_Change(ByVal target As Range)
Dim Oblast As Range, Isect As Range
Set Oblast = Range("A6:A65536") 'definuje oblasť, zmena ktorej iniciuje zápis dátumu do zvolenej bunky
Set Isect = Application.Intersect(target, Oblast)
If Not Isect Is Nothing Then
If Isect <> "" Then 'test na reťazec, pokiaľ je prázdny, dátum v korešpondujúcej bunke sa zmaže (else)
target.Offset(, 7) = WorksheetFunction.RoundDown(Now, 0) 'zapisuje dátum o 7 stĺpcov vpravo od bunky, ktorá inicializovala spustenie kódu po otestovaní, či sa nachádza v oblasti Oblast
Else: Cells(target.Row, 8).ClearContents
End If
End If
End Sub
Použitá je funkcia Nyní (Now) ale je to prakticky to samé pre Dnes (Today). Rutina má ešte jednu podstatnú výhodu, a to tú, že eliminuje výskyt volatilnej funkcie Dnes v súbore (volatilným funkciám je dobré sa vyhýbať, pokiaľ to je možné).
Edit: Ešte je potrebné stĺpec, do ktorého sa má horeuvedeným makrom zapisovať dátum (v mojom prípade stĺpec H) sformátovať na dátum, najlepšie asi dopredu
Stačí riešenie od Pavlusa. Ničmenej, pokiaľ to chceš naozaj naraz, tak miesto 3 pôvodných inštrukcií zapíš:
Range("12:23,25:31,33:40").EntireRow.Hidden = Not Range("12:23,25:31,33:40").EntireRow.Hidden
Je samozrejmé, že rozsah výstupu KT sa mení v závislosti na použitom filtry, toto asi neobídeš.
Pozíciu riadku, na ktorom sa nachádza Grand Total nájdeš cez funkciu POZVYHLEDAT (MATCH). Povedzme, že Grand Total sa nachádza na 20. riadku v stĺpci A, pre identifikáciu pozície riadku použiješ vzorec
=MATCH("Grand Total";A:A;0)
Výsledok potom môžeš použiť v nejakom inom vzorci
Tipujem, že nebudem sám, kto nerozumie zadaniu 
Pred spustením kódu vyber (označ) bunky, u ktorých chceš vidieť vzorce, ktoré obsahujú, makro ich vypíše o 5 stĺpcov vpravo od pôvodných:
Sub POM()
Dim CELL As Range
For Each CELL In Selection.Cells
With CELL.Offset(0, 5) 'hodnota 5 urcuje posun o 5 stlpcov vpravo
.NumberFormat = "@"
.Value = CELL.FormulaLocal
End With
'uvedene najprv sformatuje bunku na text a nasledne do nej zapise vzorec
'miesto bloku With-End With by ako alternativa slo pouzit:
'With CELL
'.Offset(0, 5).Value = "'" & .FormulaLocal
'End With
'tj. to, co doporucoval Stalker pisat manualne
Next
End Subinak si myslím, že v tom videu to je urobené cez udalostné makro, do kódového okna ThisWorkbook je treba vložiť kód:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
With Target.Offset(-1, 1) 'hodnota offset urcuje posun o 1 stlpec vpravo a jeden riadok nahor
.NumberFormat = "@"
.Value = Target.Offset(-1, 0).FormulaLocal
End With
End SubPo zapísaní vzorca do bunky (napr. A3) a odentrovaní (pokiaľ máš nastavený posun po stisku enter smerom dolu), tak sa do bunky vedľa prepíše ten vzorec. Prípadne je ešte do kódu možný dopísať test na to, či Target predstavuje bunku z nejakej oblasti, aby to nerobilo psie kusy v celom zošite, ale zapisovalo vzorec iba pri zápise pôvodného vzorca v dopredu určenej oblasti.
To by potom vyzeralo nejako nasledovne (kontrola pre oblasť F3:F10 na Liste1, čiže len v prípade zápisu do bunky v uvedenej oblasti dojde k zápisu vzorca do bunky vedľa):
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Isect As Range
On Error Resume Next 'osetruje pripad zapisu do 1.riadku v liste
Set Isect = Intersect(Target.Offset(-1, 0), Range("f3:f10"))
If (Sh.Name = "List1" And Not Isect Is Nothing) Then
With Target.Offset(-1, 1)
.NumberFormat = "@"
.Value = Target.Offset(-1, 0).FormulaLocal
End With
End If
End Sub
No, ono to síce nejde (asi), pred zavretím súboru, ničmenej, po tom, čo ho zavrieš, tak to pôjde, ovšem procedúrou, ktorá je umiestnená v nejakom otvorenom súbore, príklad tuná:Sub Premenuj()
Name "D:\MyDocuments\jablko.xlsm" As "D:\MyDocuments\hruška.xlsm"
End Sub
Ahoj, dá sa to vyriešiť i manuálne, klikom do legendy a následným klikom na určitú položku v legende, ktorým ju vyberieš. Klikom pravým tlačítkom vyberieš z kontextového menu formátovanie a zvolíš si farbu, v grafe sa to potom prekreslí. Pokiaľ ale chceš jeden odtieň pre 60-80 a iný pre 80-95, budeš musieť nataviť hlavnú jednotku osy na 5, tým pádom Ti do legendy pribudnú položky, štyrom pre rozsah 60-80 priradíš jednu farbu a trom pre rozsah 80-95 farbu inú, atď. Legendu z grafu môžeš následne odstrániť, prípadne miesto nej vložiť odrázok legendy pôvodnej, prípadne si nejaký popisok (legendu) do grafu dotvoriť ručne. Trochu opruz, ale toto je jediné non-VBA riešenie, ktoré ma napadá.
čerpal som z tohoto textu:
The only way to format the colors of a range of data in a surface chart is through the legend. It takes one click to select the legend, a second to select the small colored square, and then a double click to access the Format Legend Key dialog (this is a good time to use CTRL-1). This is one way to format a series in a more conventional chart, but it's the only way to format the data colors in a surface chart.
Link na zdroj: http://pubs.logicalexpressions.com/Pub0009/LPMArticle.asp?ID=447
Pokiaľ by si chcel VBA, tak si uprav nasledujúci kód (mení farbu u počtu položiek v legende, ktorý si riadiš cez premennú i v kóde:
Sub Test()
Dim C As Chart
Dim i As Long, Max As Long
Dim Red As Integer, Blue As Integer
Set C = ActiveSheet.ChartObjects("Graf 1").Chart
With C.Legend
Max = .LegendEntries.Count 'použi prípadne v cykle, v tento moment to kód nepoužíva
For i = 1 To 4 'pohraj si s indexom a farbičkami pre jednotlivé rozsahy
Red = 220
Blue = 0
.LegendEntries(i).LegendKey.Interior.Color = RGB(Red, 0, Blue)
Next
End With
End Sub
Vzorec, ktorý som uviedol, Ti nedáva púhy súčet jedným číslom, ale running total (medzisúčty)pre každý záznam (pre jednotlivé dátumy). Je ale možné, že nerozumiem presne, čo potrebuješ, asi by to chcelo nejaký príklad i s výsledkami, a popismi, čo vlastne požaduješ, nielen tabuľku zdrojových dát.
medzi riadky Next a a.WriteLine s vlož inštrukciu:
s = Left(s, Len(s) - 2)
Zostane Ti na konci jeden prázdny riadok, na jeho odstránenie by si potreboval nejakú inštrukciu fs (file scripting) ale to presahuje moje aktuálne znalosti
Kontroly v ľavej časti práve slúžia k tomu, aby si úlohy rozdeľoval čo možno rovnomerne, ako som spomínal, dorob si tam podmienené formátovanie a myslím, že sa to dá používať. Príklad možného správneho vyplnenia posielam, je to trošku také sudoku :)
Ešte som opravil vzorce v riadkoch 38 a 40, bola v nich chyba.
Nieco som stvoril, mas tam i nejake kontroly, staci zadavat hodnoty v tej oramovanej casti na prvom liste, pod nou mas cervene instrukcie, vlavo nejaku jednoduchu statistiku, tabulkovy vystup na druhom liste. Dalsie kontroly, potlacenie zobrazenia nul a pripadne podmienene formatovanie a dalsie blbiny si uz dorobis.
Som síce veľký fanda VBA ale priznám sa, že mi nie je jasné, k čomu je v tomto prípade dobré niečo programovať, keď stačí do súboru od kasica dopísať do bunky E2 vzorec:
=SUM(A$2:A2)-SUM(D$2:D2)
(prípadne maticovo =SUM(A$2:A2;-(D$2:D2)), eventuálne =SUM(A$2:A2-D$2:D2) )
a skopírovať dolu. Pre priemer potom použiť
=AVERAGE(E:E) a pre maximum =MAX(E:E)
Po tom, čo si ten kód skopíruješ, zmaž v ňom prázdne riadky, aspoň tie medzi For i a Next, tento web tam pridáva tie riadky nezmyselne a kód potom blbne na tom Then _
skus toto, netestoval som, ale snad som v tom neurobil chybu:
Sub export()
Dim fs As Object, a As Object, i As Long, M As Long, s As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("\\Složka\" & "E2-" & Range("R42").Value & ".txt", True)
M = Range("B1048575").End(xlUp).Row 'pokial mas excel 2007 tak miesto "B1048575" napis "B65536"
For i = 89 To M
If Not IsEmpty(Cells(i, 2)) Then _
s = s & Cells(i, 1) & Chr(9) & Cells(i, 2) & Chr(9) & Cells(i, 3) & Chr(9) & Cells(i, 4) & Chr(9) & Cells(i, 5) & Chr(9) & Cells(i, 6) & Chr(9) & Cells(i, 7) & Chr(9) & Cells(i, 8) & Chr(9) & Cells(i, 9) & Chr(9) & Cells(i, 10) & Chr(9) & Cells(i, 11) & Chr(9) & Cells(i, 12) & Chr(9) & Cells(i, 13) & Chr(9) & Cells(i, 14) & Chr(9) & Cells(i, 15) & Chr(9) & Cells(i, 16) & Chr(9) & Cells(i, 17) & Chr(9) & Cells(i, 18) & Chr(9) & Cells(i, 19) & Chr(9) & Cells(i, 20) & Chr(9) & Cells(i, 21) & Chr(9) & vbNewLine
Next
a.WriteLine s
a.Close
End Sub
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články