Egy oszlop három oszlopra bontása makróval

Hogyan szedjük szét azt az egy oszlopos adathalmazt több oszlopra, amiben az adattípusok cikliklusan egymás alatti sorokban szerepelnek?

1. A probléma

A problémánk a következő: három oszlopot szeretnénk látni az Excel táblánkban:

1. Név
2. Település
3. Évszám

Azonban az adatforrásunk struktúrája miatt egy oszlopban van mindenünk. Minden első sor tartalmazza a nevet, minden második a települést, minden harmadik az évszámot. Az adatforrásunk több ezer soros, így nincs az az isten, hogy manuálisan álljunk neki Ctrl+C Ctrl+V-zni.

Nincs mese, csakis VBA-ban egy makrót írva tudjuk megoldani ezt az Excel feladatot.

2. Ha még új vagy az Excel makrók terén

Abban az esetben ha még nincs beállítva az Excel menüsorodban a „Fejlesztőeszközök” menüpont, ha még nem hoztál létre új makrót, és ha még nem írtál VBA nyelvben programot, akkor kezdő lépésnek olvasd el az „Excel Makró – VBA Alapok” tananyagom 1. leckéjét.

Ennek ismeretében mehetünk tovább a 3. pontra.

3. A VBA programunk

Tehát a feladatunk, hogy az „A” oszlopban szereplő sorokat válogassuk szét:

• Minden első sor maradjon ott ahol van, az első oszlopban, hiszen azok lesznek a nevek.
• Minden második sort tegyünk át a „B” oszlopba, de ügyeljünk rá, hogy egy sorral feljebb kerüljön, azaz egy sorban legyen a hozzá tartozó „név” adattal az „A” oszlopból.
• Minden harmadik sort tegyünk át a „C” oszlopba, és itt is figyeljünk arra, hogy a hozzá tartozó „név” és „város” adattal egy sorba kerüljön.

A feladathoz szükségünk van a „For” ciklusra, az „If” elágazásra, valamint a „Mod” operátorra.

A „Mod” operátor

A „Mod” operátor két szám hányadosának egész számú maradékát adja vissza. Azaz például ha a 8-at osztom 2-vel, akkor az kereken 4, tehát a maradék 0.

8 / 2 = 4

8 mod 2 = 0

Ha a 9-et osztom 2-vel, akkor az 4,5 lesz, viszont 9-ben a kettő kerekek egész számként csak négyszer van meg, plusz marad 1 egész.

9 / 2 = 4,5

9 mod 2 = 1

Ennek ismeretében a következő lesz a programunk:

Sub Makró1()
'Tegyük fel, hogy 1000 sorunk van. Végigmegyünk az összes soron az elsőtől az ezerig.
 For i = 1 To 1000
 'Ha az adott sornak a számát elosztjuk hárommal, és a maradék egy lesz, akkor az az első öszlop marad. Azaz ezzel nem kell csinálnunk semmit.
  If i Mod 3 = 1 Then
  'Viszont ha a maradék nem egy, akkor dolgunk lesz vele. 
  ElseIf i Mod 3 <> 1 Then     
  'Amennyiben a maradék nulla, úgy minden 3. sorról beszélünk, azaz azokat tegyük át a 3. oszlopba.
   If i Mod 3 = 0 Then         
    Worksheets("Munka1").Cells(i - 2, 3).Value = Cells(i, 1).Value            
    Cells(i, 1).Value = ""     
   'Minden más esetben a második adatról beszélünk, azaz amelyeket a 2. oszlopba kell áthelyeznünk.     
   Else         
    Worksheets("Munka1").Cells(i - 1, 2).Value = Cells(i, 1).Value          
    Cells(i, 1).Value = ""     
   End If 
  End If
 Next
 MsgBox "Kész"
End Sub

Végeredményként az üres sorokat pedig vagy „Ismétlődések eltávolításával” egyszerűen csak töröljük, vagy plusz pontért ezt is belefejleszthetjük a makrónkba. 🙂