Excel - makro pro navýšení souřadnice sloupců?

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

sleapy
nováček
Příspěvky: 10
Registrován: prosinec 10
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel - makro pro navýšení souřadnice sloupců?

Příspěvekod sleapy » 07 pro 2010 00:59

Aha, úpravu toho vzorce jsem zkoušel, ale nějak jsem zapomněl na to makro :(.

Ještě než přestanu otravovat bych se rád zeptal na jednu věc - vytvořil jsem si první, řekněme betaverzi, souboru, která vypadá použitelně pro mé účely. Příprava mi zabrala dost času a řek jsem si, že bych to trochu zautomatizoval, tzn. že bych si udělal kopii souboru, kde bych jen nahrál nová data a popřípadě upravil adresaci (mám celkem 3 podobné soubory), pokud by to bylo nutné. Nad čím však přemýšlím je, zda je možné odkaz na offsetu ='UkazkaReseni.xls'!GrafOsaX odkazovat nějak relativně - jakmile totiž report přejmenuji, tak mi přestávají oblasti fungovat. Hledal jsem nějakou nápovědu, ale neúspěšně - problém bude v tom, že nevím, pod čím tento problém přesně hledat.

Reklama
navstevnik
Level 4
Level 4
Příspěvky: 1142
Registrován: srpen 08
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel - makro pro navýšení souřadnice sloupců?

Příspěvekod navstevnik » 07 pro 2010 07:18

Pokud vytvoris kopii sesitu UkazkaReseniPostup.xls, tak jsou odkazy v grafech automaticky upraveny, muzes trochu vice objasnit zamer?

Ps: nize je efektivnejsi udalostni procedura, kterou nahrad puvodni v modulu listu Dashboard (pripadne uprav ofset pro jiny pocet mesicu v grafech, tedy na 13):

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$I$45" And Target.Address <> "$K$45" Then
    Exit Sub
  Else
    Dim SoucMM As String, PredchMM As String, LonskyMM As String
    Dim Pole As Variant
    With Me
      If .Range("i45").Value = vbNullString Then
        .Range("i45").Value = 2008  ' osetreni prazdne bunky!
      End If
      Pole = Split(.Range("b3").Offset(0, ((.Range("i45").Value - 2007) * 12) + (.Range("k45").Value) - 1).Address, "$")
      .Range("l45").Value = Pole(1)  ' sloupec pro soucasny stav
      Pole = Split(.Range("b3").Offset(0, ((.Range("i45").Value - 2007) * 12) + (.Range("k45").Value) - 2).Address, "$")
      .Range("m45").Value = Pole(1)  ' sloupec pro predchozi mesic
      Pole = Split(.Range("b3").Offset(0, ((.Range("i45").Value - 2007) * 12) + (.Range("k45").Value) - 13).Address, "$")
      .Range("n45").Value = Pole(1)  ' sloupec pro soucasny mesic - 12
      .Range("o45").Value = ((.Range("i45").Value - 2007) * 12) + (.Range("k45").Value) - 12  ' offset pro grafy 12 mesicu
    End With
  End If
End Sub

sleapy
nováček
Příspěvky: 10
Registrován: prosinec 10
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel - makro pro navýšení souřadnice sloupců?

Příspěvekod sleapy » 15 pro 2010 07:54

Dobrý den,
velice se omlouvám za prodlevu v komunikaci. Co se týče té kopie sešitu, tak to jsem nevěděl - pokoušel jsem se vždy soubor přejmenovat klasicky v total commanderu a to samozřejmě nefungovalo. Díky za tip!

Ohledně nové metody, už na mne vypadá moc programátorsky, ale určo ji vyzkoušim :) Ještě bych měl jeden dotaz, upravil jsem trochu makro, resp. přidal jsem ještě další instrukce pro zpracování dalších výsledků. Vytvořil jsem proto nové proměnné, které vychází ze stávajících, data se mi ukládají do jiných buněk v dashboardu. Co mne trochu trápí je, že k se s adresou nových sloupců ukládá i znak , nechápu ale proč.

Je mi jasné, že "můj" výtvor je spíše asi k smíchu, ale zatím jsem nepřišel (či spíše, je to vůbec možné?) na to, jak se dá vytvořit více procedur - například pro posun na jiné souřadnice, protože mám v jiném souboru grafy, které se mi tvoří ještě z jiného listu, který nemohu přizpůsobit listu Data celkem.

Kód: Vybrat vše




Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$I$45" And Target.Address <> "$K$45" Then
    Exit Sub
  Else
    Dim SoucMM As String, PredchMM As String, LonskyMM As String, PredLonskyMM As String, SoucMM2 As String, PredchMM2 As String, LonskyMM2 As String, PredLonskyMM2 As String
    With Me
      If .Range("i45").Value = vbNullString Then
        .Range("i45").Value = 2009  ' osetreni prazdne bunky!
      End If
      SoucMM = .Range("b3").Offset(0, ((.Range("i45").Value - 2008) * 12) + (Range("k45").Value) - 1).Address
      PredchMM = .Range("b3").Offset(0, ((.Range("i45").Value - 2008) * 12) + (Range("k45").Value) - 2).Address
      LonskyMM = .Range("b3").Offset(0, ((.Range("i45").Value - 2008) * 12) + (Range("k45").Value) - 13).Address
      PredLonskyMM = .Range("b3").Offset(0, ((.Range("i45").Value - 2008) * 12) + (Range("k45").Value) - 26).Address
      .Range("l45").Value = Mid(SoucMM, 2, InStr(2, SoucMM, "$", vbTextCompare) - 2) ' sloupec pro soucasny stav
      .Range("m45").Value = Mid(PredchMM, 2, InStr(2, PredchMM, "$", vbTextCompare) - 2) ' sloupec pro predchozi mesic
      .Range("n45").Value = Mid(LonskyMM, 2, InStr(2, LonskyMM, "$", vbTextCompare) - 2) ' sloupec pro soucasny mesic - 12
      .Range("o45").Value = ((.Range("i45").Value - 2008) * 12) + (Range("k45").Value) - 13 ' offset pro grafy 12 mesicu
      .Range("p45").Value = ((.Range("i45").Value - 2008) * 12) + (Range("k45").Value) - 25 ' offset pro grafy lonksych 12 mesicu
     
       ' Vypocet listu Data2
      SoucMM2 = .Range("c3").Offset(0, ((.Range("i45").Value - 2009) * 12) + (Range("k45").Value) - 1).Address
      PredchMM2 = .Range("c3").Offset(0, ((.Range("i45").Value - 2009) * 12) + (Range("k45").Value) - 2).Address
      LonskyMM2 = .Range("c3").Offset(0, ((.Range("i45").Value - 2009) * 12) + (Range("k45").Value) - 13).Address
      .Range("l46").Value = Mid(SoucMM2, 2, InStr(2, SoucMM, "$", vbTextCompare) - 2) ' sloupec pro soucasny stav
      .Range("m46").Value = Mid(PredchMM2, 2, InStr(2, PredchMM, "$", vbTextCompare) - 2) ' sloupec pro predchozi mesic
      .Range("n46").Value = Mid(LonskyMM2, 2, InStr(2, LonskyMM, "$", vbTextCompare) - 2) ' sloupec pro soucasny mesic - 12
      .Range("o46").Value = ((.Range("i45").Value - 2009) * 12) + (Range("k45").Value) - 12 ' offset pro grafy 12 mesicu

    End With
  End If
End Sub


navstevnik
Level 4
Level 4
Příspěvky: 1142
Registrován: srpen 08
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel - makro pro navýšení souřadnice sloupců?

Příspěvekod navstevnik » 15 pro 2010 12:31

Nejprve: znak navic - pro puvodni konstrukci vypoctu vzhledem k tomu, ze data pro "soucasny mesic" a predchozi mesice zasahovala pouze do oblasti sloupcu s dvoupismennym indexem, nebylo nutno pouzit slozitejsi vypocet osetrujici i jednopismenne indexy.
Upravena procedura jiz davala regulerni vysledek i pro jednopismenne indexy.

Ve vypoctu ofsetu pro grafy, kdy je pozadovan ofset 25 mesicu, musi data zacinat rokem 2007, omezeni zadavaneho roku je pak na 2009. Ve vzorcich musi byt pro vypocet indexu sloupcu a ofsetu odpocitavan rok 2007, tedy pocitat ofset vuci 01/2007. Jinak procedura dava nekorektni vysledek.

Nize uvedena procedura umoznuje vypocet indexu sloupcu a ofsetu pro grafy za predposlednich a poslednich 13 mesicu pro libovolny sloupec pocatku dat ( datova rada zacina 01/2007) a vysledek ulozi do radku se zadanym ofsetem vuci bunce L45.

Kód: Vybrat vše

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$I$45" And Target.Address <> "$K$45" Then
    Exit Sub
  Else
    VypoctiVloz "b3", 0 ' Data celkem: vychozi bunka B3, ofset radku = 0 pro ulozeni vysledku vuci bunce L45
    VypoctiVloz "c3", 1 ' Data2: vychozi bunka C3, ofset radku = 1 pro ulozeni vysledku vuci bunce L45
    ' zde lze pridavat dalsi zdroje dat:
'     VypoctiVloz "d3", 2 ' Data2: vychozi bunka D3, ofset radku = 2 pro ulozeni vysledku vuci bunce L45
  End If
End Sub

Sub VypoctiVloz(StartingCll As String, TargetOffsRow As Integer)
  Dim Pole As Variant, YY As Integer, MM As Byte
  Const TargetCllAddr As String = "l45" ' vychozi bunka na listu pro ulozeni vysledku
 
  With Me
    If .Range(TargetCllAddr).Offset(0, -3).Value = vbNullString Then
      .Range(TargetCllAddr).Offset(0, -3).Value = 2009  ' osetreni prazdne bunky! rok
    End If
    If .Range(TargetCllAddr).Offset(0, -1).Value = vbNullString Then
      .Range(TargetCllAddr).Offset(0, -1).Value = 1  ' osetreni prazdne bunky! mesic
    End If
    YY = .Range(TargetCllAddr).Offset(0, -3).Value
    MM = .Range(TargetCllAddr).Offset(0, -1).Value
   
    Pole = Split(.Range(StartingCll).Offset(0, ((YY - 2007) * 12) + MM - 1).Address, "$")
    .Range(TargetCllAddr).Offset(TargetOffsRow, 0).Value = Pole(1)  ' sloupec pro soucasny stav
    Pole = Split(.Range(StartingCll).Offset(0, ((YY - 2007) * 12) + MM - 2).Address, "$")
    .Range(TargetCllAddr).Offset(TargetOffsRow, 1).Value = Pole(1)  ' sloupec pro predchozi mesic
    Pole = Split(.Range(StartingCll).Offset(0, ((YY - 2007) * 12) + MM - 13).Address, "$")
    .Range(TargetCllAddr).Offset(TargetOffsRow, 2).Value = Pole(1)  ' sloupec pro soucasny mesic - 13
    .Range(TargetCllAddr).Offset(TargetOffsRow, 3).Value = ((YY - 2007) * 12) _
        + MM - 13  ' offset pro grafy 13 mesicu
    .Range(TargetCllAddr).Offset(TargetOffsRow, 4).Value = ((YY - 2007) * 12) _
        + MM - 25  ' offset pro grafy 25 mesicu
  End With
End Sub

V dynamickych pojmenovanych oblastech coby zdroje pro grafy je potreba odkazovat na prislusne bunky.

sleapy
nováček
Příspěvky: 10
Registrován: prosinec 10
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel - makro pro navýšení souřadnice sloupců?

Příspěvekod sleapy » 15 pro 2010 16:15

Ve vypoctu ofsetu pro grafy, kdy je pozadovan ofset 25 mesicu, musi data zacinat rokem 2007, omezeni zadavaneho roku je pak na 2009. Ve vzorcich musi byt pro vypocet indexu sloupcu a ofsetu odpocitavan rok 2007, tedy pocitat ofset vuci 01/2007. Jinak procedura dava nekorektni vysledek.


Rok 2009 jsem tam umístil z důvodu, že onen druhý list má bohužel data až od roku 2009 a prozatím jsem nebyl schopen to nějak upravit. Děkuji za upravenou proceduru, jdu jí blíže prozkoumat :).

Každopádně moc děkuji za vše, asi už bych Vás neměl tak dlouho "spamovat" :eh:

navstevnik
Level 4
Level 4
Příspěvky: 1142
Registrován: srpen 08
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel - makro pro navýšení souřadnice sloupců?

Příspěvekod navstevnik » 15 pro 2010 16:56

Pokud data zacinaji rokem 2009, pak muze byt zobrazen graf za predchozich 12 mesicu, ale ne za predpredchozich 12 mesicu, to az v roce 2011.
Tak to tedy jeste trochu upravim, vypocet predpredchoziho ofsetu probehne pouze pri rozdilu zadaneho roku a pocatku datove rady > 1 rok.

Doplneno 17:35:
Na listu Dashboard v Overeni nastav pro I45 cela cisla a rozsah 2009 - 20xx a pro K45 dtto 1 - 12.
Upravena procedura:

Kód: Vybrat vše

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$I$45" And Target.Address <> "$K$45" Then
    Exit Sub
  Else
  ' Data celkem: vychozi bunka B3, ofset radku = 0 pro ulozeni vysledku vuci bunce L45, datova rada od 2007
    VypoctiVloz "b3", 0, 2007
    ' Data2: vychozi bunka C3, ofset radku = 1 pro ulozeni vysledku vuci bunce L45, datova rada od 2009
    VypoctiVloz "c3", 1, 2009
    ' zde lze pridavat dalsi zdroje dat, priklad:
    ' Data2: vychozi bunka D3, ofset radku = 2 pro ulozeni vysledku vuci bunce L45, datova rada od 2008
    ' VypoctiVloz "d3", 2, 2008
  End If
End Sub

Sub VypoctiVloz(StartingCll As String, TargetOffsRow As Integer, YYFrom As Integer)
  Dim Pole As Variant, YY As Integer, MM As Byte
  Const TargetCllAddr As String = "l45"  ' vychozi bunka na listu pro ulozeni vysledku

  With Me
    If .Range(TargetCllAddr).Offset(0, -3).Value = vbNullString Then
      .Range(TargetCllAddr).Offset(0, -3).Value = 2009  ' osetreni prazdne bunky! rok
    End If
    If .Range(TargetCllAddr).Offset(0, -1).Value = vbNullString Then
      .Range(TargetCllAddr).Offset(0, -1).Value = 1  ' osetreni prazdne bunky! mesic
    End If
    YY = .Range(TargetCllAddr).Offset(0, -3).Value
    MM = .Range(TargetCllAddr).Offset(0, -1).Value

    Pole = Split(.Range(StartingCll).Offset(0, ((YY - YYFrom) * 12) + MM - 1).Address, "$")
    .Range(TargetCllAddr).Offset(TargetOffsRow, 0).Value = Pole(1)  ' sloupec pro soucasny stav
    If YY - YYFrom > 0 Then
      Pole = Split(.Range(StartingCll).Offset(0, ((YY - YYFrom) * 12) + MM - 2).Address, "$")
      .Range(TargetCllAddr).Offset(TargetOffsRow, 1).Value = Pole(1)  ' sloupec pro predchozi mesic
      Pole = Split(.Range(StartingCll).Offset(0, ((YY - YYFrom) * 12) + MM - 13).Address, "$")
      .Range(TargetCllAddr).Offset(TargetOffsRow, 2).Value = Pole(1)  ' sloupec pro soucasny mesic - 13
      .Range(TargetCllAddr).Offset(TargetOffsRow, 3).Value = ((YY - YYFrom) * 12) + MM - 13  ' offset pro grafy 13 mesicu
    Else
      Pole = Split(.Range(StartingCll).Address, "$")
      .Range(TargetCllAddr).Offset(TargetOffsRow, 1).Value = Pole(1)
      .Range(TargetCllAddr).Offset(TargetOffsRow, 2).Value = Pole(1)
      .Range(TargetCllAddr).Offset(TargetOffsRow, 3).Value = 0
    End If
    If YY - YYFrom > 1 Then
      .Range(TargetCllAddr).Offset(TargetOffsRow, 4).Value = ((YY - YYFrom) * 12) + MM - 25  ' offset pro grafy 25 mesicu
    Else
      .Range(TargetCllAddr).Offset(TargetOffsRow, 4).Value = 0
    End If
  End With
End Sub

V procedure je osetren nekorektni rozdil pocatku datove rady a zadaneho roku v I45, vysledkem je sloupec C a offset 0, coz sice neni spravny vysledek, ale nedojde k chybam ve vzorcich.

sleapy
nováček
Příspěvky: 10
Registrován: prosinec 10
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel - makro pro navýšení souřadnice sloupců?

Příspěvekod sleapy » 28 pro 2010 13:45

Opožděně díky!

Jediné, co mi trochu zlobí je generování hodnoty offsetu i pro další listy, například jsem si v proceduře za větev else nadefinoval další rozsah VypoctiVloz "c3", 1, 2009 pro jiný list začínající buňkou c3 a výsledná hodnota offsetu byla o jednu nižší (10 místo 11). Když jsem se pokusil v proceduře upravit odečet, skončilo to pro mne bohužel neúspěchem.

Moc děkuji a přeji příjemný zbytek roku

--- Doplnění předchozího příspěvku (28 Pro 2010 13:52) ---

už nic, už jsem na to přišel - chybně nadefinovaný offset. Omlouvám se za spam :x


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Navýšení RAM
    od Alzbeta » 26 říj 2023 09:16 » v Rady s výběrem hw a sestavením PC
    4
    766
    od Alzbeta Zobrazit poslední příspěvek
    26 říj 2023 19:40
  • Navýšení RAM NTB ASUS B53E
    od kuk22 » 03 bře 2024 14:14 » v Rady s výběrem hw a sestavením PC
    3
    802
    od kuk22 Zobrazit poslední příspěvek
    04 bře 2024 20:19
  • PowerQuery - import dat do sloupců Příloha(y)
    od MK_Vs » 31 říj 2023 10:00 » v Kancelářské balíky
    9
    2212
    od MK_Vs Zobrazit poslední příspěvek
    02 lis 2023 09:26
  • Makro pro myš Rapture Python
    od mmmartin » 27 srp 2023 15:18 » v Problémy s hardwarem
    9
    1285
    od mmmartin Zobrazit poslední příspěvek
    29 srp 2023 16:47
  • Excel a OneDrive
    od sginfo » 11 zář 2023 15:28 » v Kancelářské balíky
    16
    6921
    od mirekol Zobrazit poslední příspěvek
    20 říj 2023 08:31

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 4 hosti