makro VBA excel vlozeni radku medzi.... Vyřešeno

[marek26]

Ahoj

Prosim vas,.......mam maly problem. V prilohe je, zdrojovy subor + konecny vysledny subor (oto.xls) , myslim ze pro vas asi nie moc zlozite......... vidite ze mam vlozeny radek prave tam, kde sa prelina "mesiac" (napr. medzi 8 a 9) ....august a september (srpem,zari) (je to kvoli suctovani).
Moc mi to pomoze ak dokaze makro take nieco ze vlozit radek medzi cislami stlpca "mesiac" (napr. medzi 8 a 9) medzi 9 a 10 medzi 10 a 11......pochopite to ak otvorite prilohu, a urobit to ze tam prida august (srpen) atd. + prida slovo "spolu" + urobi sucet za "mesiac"
posilam zdrojovy subor(zdroj.xls) + oto.xls(co je konecny vysledok)

Datovy popis:
"mesiac" moze byt 1,2,3,4,5,6,7,8,9,10,11,12
vzdy bude zdroj zoradeny od najmensieho mesiaca (1,2,3,.....)
zdroj bude mat vzdy iny pocet radku (pocet radku bude variabilny)

dakujem Vam moc

[Reklama]

[navstevnik]

Pozadovaneho lze dosahnout bez pouziti makra. Nabidka>Data>Souhrny (snad slovenska lokalizace pouziva podobne nazvy) vykonaji vse pozadovane, vice viz napoveda nebo http://office.microsoft.com/cs-cz/excel ... 21029.aspx . Pokud ma byt v souhrnu nazev mesice, pak nahrad cislo mesice jeho nazvem.

[marek26]

no jo.......ale...........ked to robi clovek denne a potrebuje vlozit slovo spolu prave na riadok ktory je ako posledny (posledny riadok za januar, posledny riadok za augustom atd)

no je to asi dost zlozite.....neviem

[navstevnik]

Dobre, kdyz je to slozite a touzis po makru, tak zde mas makro, ktere do sloupce mesiac vlozi nazev mesice podle data ve sloupci dat.vystav (jiz neni nutne vyplnovat rucne nebo pomoci funkce) a pak vykona pozadovany souhrn. Mas tam slovo soucet (je sice v jinem sloupci), dilci i celkovy soucet ve sloupci saldo

Kód: Vybrat vše

Option Explicit

Sub Souhrn()
  Dim Sloupec As Range, last As Long, c As Range, i As Long
  Set c = Worksheets("oto").Range("D2")
  i = 0
  Do
    If c.Offset(i, 0) <> vbNullString Then _
        c.Offset(i, 1) = Format(c.Offset(i, 0).Value, "mmmm") Else Exit Do
    i = i + 1
  Loop
  Worksheets("oto").Range("A1").Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(8), _
      Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

Pred opakovanym spustenim doporucuji odstranit souhrny: Data>Souhrny>Tlacitko: Odstranit vse
V priloze je soubor s upravami.

[marek26]

tak vdaka navstevnik makro to je ono