nedelja, 5. februar 2012

Iz ene v več

Včasih je zabavno reševat izzive, ki pestijo druge. Tokratni je zanimiv problem nastal pri fajn osebi, ki ji sledim na twitterju. Zanimalo ga je, ali se da iz ene datoteke, ki ima 10.000 vrstic s podatki kopirat po 1.000 vrstic v 10 novih excelovh datototek. Seveda bi se vsega skupaj lahko lotil peš in kopiral teh 1.000 vrstic, ampak to je kršenje velikega načela, da je lenoba gibalo napredka. Verjetno je tudo res, da prevelika delavnost ne prinese nobene inovacija, toda o tem kdaj drugič.

Za sam primer sem vzel malo manjšo datoteko, ker se lahko hitro kaj zalomi in potem je potrebno na silo terminirat program. Cel procedura je podobna za kakršnokoli excelovo datoteko, ki jo želimo razdeliti na več novih datotek. Najlažje bo razumeljivo, če prebereš komentarje.

Sub razdeli()
 
    Dim i As Integer
    Dim x As Integer
    Dim wb As Workbook

    'preberemo ime trenutno odprte izvorne datoteke
    template_file = ActiveWorkbook.Name

    'določimo začetek in koliko vrstic hkrati želimo kopirati
    For i = 1 To 30 Step 5
    x = i + 5

        'v izvorni datoteki na zavihku podatki izberemo i število vrstic in 12 stolpcev
        Sheets("podatki").Select
        Range(Cells(i, 1), Cells(x, 12)).Select
        Selection.Copy


        'dodamo nov excelov zvezek
        Workbooks.Add

        'vanj prilepimo kopirane izvorne podatke
        ActiveSheet.Paste

        'vrnemo se v izvorno datoteko, kjer izberemo naslednjih i vrstic
        Windows(template_file).Activate

    Next i
End Sub


To je dejansko to. Ko zaključimo imamo 7 odprtih excelovih zvezkov; izvornega in 6 zaporednih, od katerih vsak vsebuje 5 vrstic podatkov iz izvornega zvezka. Po želji bi lahko dodali še avtomatsko shranjevanje, toda ne smemo pretiravat z delom. Pa še idej za objave mi lahko prehitro zmanjka.