Saisinko vinkkejä tai peräti valmiita ratkaisuja seuraavaan ongelmaan:
Tietojärjestelmä antaa pitkän paperisen raportin missä aina sivun ylälaidassa on samalla rivillä kaksi tarvittavaa tietoa koskien saman koko sivun rivitietoja. Järjestelmä antaa exportata tiedot exceliin saman näköisenä mitä se paperiprintissäkin on. Miten saan excelissä nämä sivun ylälaidan tiedot sivun oikeaan reunaan omille sarakkeille kyseisen sivun joka riville? Esim. ensimmäisen sivun solujen c4 ja e4 tiedot haluan siirtää h4 ja i4 soluihin SEKÄ 46 riville näiden alla (sitten alkaa taas uusi sivu). Paperiprintissä 2. sivun yläreunan tiedot ovat excelissä kohdassa c4 46 sekä e4 46, jotka haluan samoin kuin yllä siirtää pari saraketta oikealle sekä 46 riviä sen alle.
Sama ongelma lyhyesti toisin sanottuna: excel-muotoinen raportti on saman rakenteinen kuin monisatasivuinen esim. Word-dokumentti missä on header-tietoja. Nämä header-tiedot vaihtelevat kuitenkin hiukan joka sivulla. Haluan siirtää nämä header-tiedot kyseisen sivun oikeaan laitaan uusiin omiin sarakkeisiinsa.
For next ja Do loop lausekkeita olen tutkiskellut, mutta mitään edistystä en ole saanut aikaan. Olen todellinen keltanokka VBAssa, mutta homma kiinnostaa kyllä kovasti. Kiitos paljon avusta jo etukäteen!
For next ja Do loop?
3
306
Vastaukset
halusitko vain kaksi solua siirtää aina joka sivulla vaiko kaikki sarakkeen C ja e solut?
no all kahdelle solulle ja sitähän helppo muokata.
moduuliin...
Sub MuotoileSivut()
Dim Sivut As Long
Dim Rivit As Long
Dim Sivunvaihto As Long
Dim Otsikkorivi As Long
On Error Resume Next
Rivit = Range("C65536").End(xlUp).Row()
Sivunvaihto = ActiveSheet.HPageBreaks(1).Location.Row() - 1
'jos sivunvaihtoja ei ole tehty joudut käyttämään
'Sivunvaihto = 46
Sivut = (Rivit / Sivunvaihto) 1
For i = 0 To Sivut
Otsikkorivi = 4 i * Sivunvaihto
Range("H" & Otsikkorivi) = Range("C" & Otsikkorivi)
Range("I" & Otsikkorivi) = Range("E" & Otsikkorivi)
Range("C" & Otsikkorivi) = ""
Range("E" & Otsikkorivi) = ""
Next
End Sub
tai vaihtoehtoisesti voit liittää Workbook_BeforePrint tapahtumaan ThisWorkbook, niin ei tartte koodia erikseen suorittaa, vaan se suoritetaan aina ennen printtausta
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Sivut As Long
Dim Rivit As Long
Dim Sivunvaihto As Long
Dim Otsikkorivi As Long
On Error Resume Next
Rivit = Range("C65536").End(xlUp).Row()
Sivunvaihto = ActiveSheet.HPageBreaks(1).Location.Row() - 1
'jos sivunvaihtoja ei ole tehty joudut käyttämään
'Sivunvaihto = 46
Sivut = (Rivit / Sivunvaihto) 1
For i = 0 To Sivut
Otsikkorivi = 4 i * Sivunvaihto
Range("H" & Otsikkorivi) = Range("C" & Otsikkorivi)
Range("I" & Otsikkorivi) = Range("E" & Otsikkorivi)
Range("C" & Otsikkorivi) = ""
Range("E" & Otsikkorivi) = ""
Next
End Sub- keke2009
Kiitos paljon vastauksesta!
En vielä päässyt kokeilemaan kaavaa. Nuo sivuvaihdot kuitenkin vaikuttivat sen verran oudoilta, että haluaisin vielä hiukan varmentaa että tulin oikein ymmärretyksi.
Yksinkertaistettuna raporttini on alla olevan näköinen paperisena. Samat tiedot ovat myös excelissä. Haluan siirtää jokaisen sivun ensimmäiseltä riviltä tietoja.
A1,B1,C1,D1,E1,
A2,B2,C2,D2,E2
A3,B3,C3,D3,E3
A4,B4,C4,D4,E4
---pagebreak—
A5,B5,C5,D5,E5,
A6,B6,C6,D6,E6
A,7,B7,C7,D7,E7
A8,B8,C8,D8,E8
---pagebreak—
...
...
Excelissä haluan seuraavaa (yksinkertaistettuna):
A1,B1,C1,D1,E1,B1,D1
A2,B2,C2,D2,E2,B1,D1
A3,B3,C3,D3,E3,B1,D1
A4,B4,C4,D4,E4,B1,D1
A5,B5,C5,D5,E5,B5,D5
A6,B6,C6,D6,E6,B5,D5
A,7,B7,C7,D7,E7,B5,D5
A8,B8,C8,D8,E8,B5,D5
... ... ...
... … …
Yritin tehdä tästä jo makroa (työläs), mutta en saanut sitä toimimaan. Excel herjasi että koodi oli liian pitkä sillä rivejä oli jokunen tuhat. Tein sen jälkeen karvalakkimallin kaavahauilla.
Ajattelin että Do Loop kattaa tuon ”yhden sivun” tiedon siirtämisen. For Nextillä sitten katetaan tuon koko ”sivumäärän” eli muutaman tuhannen tietorivin kattaminen. keke2009 kirjoitti:
Kiitos paljon vastauksesta!
En vielä päässyt kokeilemaan kaavaa. Nuo sivuvaihdot kuitenkin vaikuttivat sen verran oudoilta, että haluaisin vielä hiukan varmentaa että tulin oikein ymmärretyksi.
Yksinkertaistettuna raporttini on alla olevan näköinen paperisena. Samat tiedot ovat myös excelissä. Haluan siirtää jokaisen sivun ensimmäiseltä riviltä tietoja.
A1,B1,C1,D1,E1,
A2,B2,C2,D2,E2
A3,B3,C3,D3,E3
A4,B4,C4,D4,E4
---pagebreak—
A5,B5,C5,D5,E5,
A6,B6,C6,D6,E6
A,7,B7,C7,D7,E7
A8,B8,C8,D8,E8
---pagebreak—
...
...
Excelissä haluan seuraavaa (yksinkertaistettuna):
A1,B1,C1,D1,E1,B1,D1
A2,B2,C2,D2,E2,B1,D1
A3,B3,C3,D3,E3,B1,D1
A4,B4,C4,D4,E4,B1,D1
A5,B5,C5,D5,E5,B5,D5
A6,B6,C6,D6,E6,B5,D5
A,7,B7,C7,D7,E7,B5,D5
A8,B8,C8,D8,E8,B5,D5
... ... ...
... … …
Yritin tehdä tästä jo makroa (työläs), mutta en saanut sitä toimimaan. Excel herjasi että koodi oli liian pitkä sillä rivejä oli jokunen tuhat. Tein sen jälkeen karvalakkimallin kaavahauilla.
Ajattelin että Do Loop kattaa tuon ”yhden sivun” tiedon siirtämisen. For Nextillä sitten katetaan tuon koko ”sivumäärän” eli muutaman tuhannen tietorivin kattaminen.esimerkissäsi on nyt sivulla 4 riviä tietoa... ekassa viestissäsi puhuit 46 rivistä, ok jos excelissä on tehty sivunvaidot aina samalla jaolla niin koodi pelaa. Jos ei ole sivunvaihtoja thety niin laita manuaalisesti esim . viimeisen esimerkkisi mukaisesti 5
moduuliin...
Sub MuotoileSivut()
Dim Sivut As Long
Dim Rivit As Long
Dim Sivunvaihto As Long
Dim Rivi As Long
Dim Otsikkorivi As Long
Dim i As Integer
Dim j As Integer
On Error Resume Next
Application.ScreenUpdating = False
Rivit = Range("C65536").End(xlUp).Row()
Sivunvaihto = ActiveSheet.HPageBreaks(1).Location.Row() - 1
'jos sivunvaihtoja ei ole tehty joudut käyttämään manuaalista arvoa - esimerkissäsi oli nyt 5 riviä
'eli hipsaa ylempänä oleva rivi Sivunvaihto = ActiveSheet.HPageBreaks(1).Location.Row() - 1 ja
'poista allaolevalta riviltä hipsu Sivunvaihto = 5
'Sivunvaihto = 5
Sivut = (Rivit / Sivunvaihto) 1
Rivi = 1
Otsikkorivi = 1
For i = 1 To Sivut
For j = 1 To Sivunvaihto
Range("F" & Rivi) = Range("B" & Otsikkorivi)
Range("G" & Rivi) = Range("D" & Otsikkorivi)
Rivi = Rivi 1
If Rivi = Rivit 1 Then Exit Sub
Next
Otsikkorivi = Otsikkorivi Sivunvaihto
Next
Application.ScreenUpdating = True
End Sub
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Yritän tänään laittaa taajuudet kohdilleen
Jotta törmätään kirjaimellisesti. Ei tätä kestä enää perttikään. Olet rakas ❤️662328Onko kaivattusi
kyltymätön nainen, pystyisitkö olemaan hänelle loputon mies, vai meneekö toisinpäin.381903Viulu vaiennut
Eikö pisnikset suju ? Vai miksi pahin yrittäjä vouhka on "kadonnu" maan alle. 🤣291646Vanhuksen varpaankynsien leikkaus 89 euroa...
Huh huh.......Parturikäynti olisi varmasti ollut 250 euroa? Kallis on suomi nykyään.1761603Anne Kukkohovi. Myy likaisia alushousujaan.
Kuka ihme ostaa jonkun naisen likaisia alushousuja, menee lujaa kyllä tälläkin housujen myyjällä.991479Nainen, sellaista tässä ajattelin
Minulla on olo, että täällä on edelleen joku, jolla on jotain käsiteltävää. Hän ei ole päässyt lähtemään vielä vaan jost1851253Kauanko skuutteja on siedettävä? Ei tietoa liikennesäännöistä, ajellaan miten sattuu ja missä vain.
Kauanko on kestettävä sähköpotkulautojen terrorismismia? Niillä ajelevat eivät tiedä, tai jos tietävätkin, niin eivät vä1281226Kyllä tekee kipeää
Luopua kaikesta mitä on elämässä saavuttanut😞 ei vaan ole enää yhtäkään hiljaista vuorokautta🤬251146En mä tiedä mitä tapahtuu
siis tykkäisitköhän musta oikeasti. Ehkä oot pelannu liikaa rahapelejä, ehkä rakastat tyhjiä arpoja.9962- 77959