MS Excel

nebude vam stacit Pivot Tabulka vytvorena s pomocnym stlpcom???citovat

Nasledujúci kód si daj pod tlačítko. Budeš musieť spúšťať pri zmene na liste Leden (po tom, čo vyplníš list, alebo ho nejako zmeníš), kód vytvorí zoznam na liste ZAZNAM vždy celý odznovu (farbičky som neriešil):Option Explicit

Sub Generuj()
Dim myRng As Range, myArray() As Variant, i As Integer, datum As Date

Set myRng = Sheets("ZAZNAM").[A9].CurrentRegion

With myRng
If .Rows.Count > 1 Then
Set myRng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
myRng.ClearContents
End If
End With

With Sheets("LEDEN")
Set myRng = .[A2]
Do While myRng <> ""
With myRng
If .Offset(0, 4) = "U" Then
ReDim Preserve myArray(3, i)
myArray(0, i) = .Value
myArray(1, i) = .Offset(0, 4)
myArray(2, i) = Format(.Offset(0, 1), "h:mm")
myArray(3, i) = Format(.Offset(0, 2), "h:mm")
i = i + 1
End If

If .Offset(0, 3) = "C" Then
If .Offset(-1, 3) <> "C" Then
ReDim Preserve myArray(3, i)
myArray(0, i) = .Value
datum = .Value
myArray(1, i) = .Offset(0, 3)
myArray(2, i) = Format(.Offset(0, 1), "h:mm")
myArray(3, i) = Format(.Offset(0, 2), "h:mm")
i = i + 1
Else:
myArray(0, i - 1) = datum & "-" & myRng
myArray(3, i - 1) = Format(.Offset(0, 2), "h:mm")
End If
End If
Set myRng = .Offset(1, 0)
End With
Loop
End With

Sheets("ZAZNAM").[A10].Resize(UBound(myArray, 2) + 1, UBound(myArray, 1) + 1) = WorksheetFunction.Transpose(myArray)
Set myRng = Nothing
Erase myArray
End Subcitovat

Prípadne do okna ThisWorkbook vlož ešte:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "ZAZNAM" Then Call Generuj
End SubPo kliknutí do (aktivovaní) listu ZAZNAM sa makro spustí automaticky a nemusíš klikať na žiadne tlačítko.citovat

Všimla jsem si ještě, že zapsaná data do tabulky záznam smažou vše co přiléhá k nově vytvořené oblasti - písal som, makro vždy vytvorí celý zoznam znovu, pred jeho vytvorením zmaže pôvodne vytvorený, to sa deje v časti Set myRng = Sheets("ZAZNAM").[A9].CurrentRegion

With myRng
If .Rows.Count > 1 Then
Set myRng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
myRng.ClearContents
End If
End Witha pokud není na listu leden ani jeden znkak, který se má přepsat do záznamu, skončí spuštění makra chybou. Je možné ošetriť, miestoSheets("ZAZNAM").[A10].Resize(UBound(myArray, 2) + 1, UBound(myArray, 1) + 1) = WorksheetFunction.Transpose(myArray)napísať: Select Case Not myArray
Case -1:
Case Else: Sheets("ZAZNAM").[A10].Resize(UBound(myArray, 2) + 1, UBound(myArray, 1) + 1) = WorksheetFunction.Transpose(myArray)
End SelectŠlo by to ještě upravit tak, že pokud bych měla více listů leden, únor, březen atd.. Tak, ako to je napísané, to pre daný prípad fungovať nebude, muselo by sa to prepísať. Bez nároku na odmenu ale riešim iba záležitosti, ktoré mi nezaberú viac, než hodinu času, takže doporučím vhodnejší prístup, ktorý nebude znamenať dramatickú úpravu makra, ktorú by si mohla zvládnuť, sama (písala si, že stačí nakopnúť, nie že to má niekto tvoriť celé za Teba). K zmienenej úprave: Nedoporučujem vytvárať samostatný list pre každý mesiac zvlášť. Miesto toho, zapisuj dáta za všetky mesiace do jednoho listu pod seba, akurát pridaj stĺpec s názvom mesiaca, ktorého sa záznam týka. Na liste výstup si tiež pridaj jeden stĺpec pre názov mesiaca. Prvý rozmer poľa myArray zvýš o jedna, t.j. miesto ReDim Preserve myArray(3, i) do kódu napíš ReDim Preserve myArray(4, i) kde do myArray(4, i) načítaj príslušnú bunku s názvom mesiaca. Podmienku v časti If .Offset(0, 3) = "C" Then
If .Offset(-1, 3) <> "C" Thenbudeš musieť ešte rozšíriť o test, či riadok X a riadok X-1 sa týka rovnakého mesiaca. Kód bude naďalej generovať vždy celý zoznam odznova za všetky mesiace.
a také nerozumím poslední části kódu od Sheets("Zaznam").[A10] - to je práve problém, že nerozumieš. Vtip je totiž v tom, že záznamy sú prvotne z Listu LEDEN ukladané v cykle do poľa myArray a až potom, čo je pole naplnené, tak je jeho obsah vložený do oblasti buniek, ktorá musí byť rovnakého rozsahu (rozmeru) ako uvedené pole. Ten rozsah buniek, kam sa má obsah poľa preniesť, sa deje práve cez inštrukciu:Sheets("ZAZNAM").[A10].Resize(UBound(myArray, 2) + 1, UBound(myArray, 1) + 1)
A taky tomu proč te tam Loop co to dělá? Ukončuje cyklus (vracia na jeho začiatok); začiatok cyklu je v tomto prípade slovo Do [While].
Nebolo mojim úmyslom v tomto príspevku motať Ti hlavu, ale je mi jasné, že chaos v tom mať budeš. Chce to študovať. Mňa zmiatla Tvoja poznámka úvodom:Ráda bych to vyřešila VBA makrem, které budu spouštět přes tlačítko poté co vyplním list, ale už nad tím dumám týden a nic mě nenapadá. Mal som za to, že VBA trochu ovládaš, ale pokiaľ nevieš, čo znamená Loop tak je pred Tebou ešte dlhá cesta citovat