Tiirafoorumi

Olen tuonut havaintoja Tiirasta Exceliin ja jatkokäsittelyn helpottamiseksi tarvetta olisi makroille. Olisiko jollakin valmiina makro, joka poimisi ensimmäisen havainnon joka lajista? Haluaisin siis poimia Excel-taulokosta ensimmäisen tietueen joka nimikkeestä(lajista).

jjuju kirjoitti:Olen tuonut havaintoja Tiirasta Exceliin ja jatkokäsittelyn helpottamiseksi tarvetta olisi makroille. Olisiko jollakin valmiina makro, joka poimisi ensimmäisen havainnon joka lajista? Haluaisin siis poimia Excel-taulokosta ensimmäisen tietueen joka nimikkeestä(lajista).

Hei,

Minusta tämä onnistuu kohtuullisen helposti käsipelilläkin...
Ohjeesta tuli aika pitkä, kun tein sen rautalangasta;)

Lataa aluksi data Exceliin (ohje toisaalla).

Jos data ei valmiiksi ole lajijärjestyksessä, järjestä data:
Huomaa, että tämä järjestää lajit aakkosjärjestykseen, sen vuoksi olisi parempi järjestää data Tiirassa lajijärjestykseen, eikä kajota siihen enää Excelissä.
- Valitse koko data näppäinkomennolla Ctrl-a (pidä control-nappi pohjassa ja paina a)
- Valitse Data -valikosta Sort (Järjestä)
- Jos ei ole valittuna, niin klikkaa Header-row (Otsikkorivi) -pompula valituksi.
- Valitse ylimpään Sort By laatikkoon "Laji"
- Valitse keskimmäiseen Sort By laatikkoon "Pvm1"
- Klikkaa OK

Lisää kaksi saraketta datan alkuun:
- Valitse sarakkeet A ja B
- Valitse Insert -valikosta komento Columns (Lisää - Sarakkeita)

Lisää näihin sarakkeisiin otsikot
- Mene soluun A1
- Kirjoita Uusi laji
- Mene soluun B1
- Kirjoita 1

Lisää soluun A2 kaava jolla testataan onko laji sama:
- Mene soluun A2
- Kirjoita soluun kaava =IF(D2=D1;0;1) tai suomenkielisessä Excelissä =JOS(D2=D1;0;1) ja paina enteriä
- Mene soluun B2
- Kirjoita soluun kaava =B1+1

Kopioi kaavat alaspäin koko data-alueeseen (esimerkiksi näin)
- Mene soluun C2
- Paina näppäintä end
- Paina näppäintä nuoli alas (aktiiviseksi tulee viimeinen datarivi)
- Siirry vaikkapa nuolinäppäimellä kaksi askelta vasemmalle, eli viimeisen datarivin A-sarakkeen soluun.
- Paina vaihto näppäin (shift) pohjaan ja pidä se painettuna kunnes toisin kehotetaan;) (se millä saa mm ison kirjaimen)
- Paina näppäintä end
- Paina näppäintä nuoli ylös (valituksi tulevat A-sarake solusta A2 viimeiseen datariviin saakka)
- Paina näppäintä nuoli oikealle (valituksi tulevat A ja B-sarakkeet solusta A2 viimeiseen datariviin saakka)
- Vapauta vaihto näppäin (shift)
- Valitse Edit -valikosta Fill - Down (Muokkaa - Täytä - Alas).

Muuta kaavat lukuarvoiksi:
- Valitse sarakevalitsimista sarakkeet A ja B
- Valitse Edit -valikosta Copy (Muokkaa - Kopioi).
- Valitse Edit -valikosta Paste Special (Liitä määräten)
- Valitse Values (Arvot)
- Klikkaa OK

Järjestä ensimmäiset havainnot alkuun:
- Valitse koko data näppäinkomennolla Ctrl-a (pidä control-nappi pohjassa ja paina a)
- Valitse Data -valikosta Sort (Järjestä)
- Jos ei ole valittuna, niin klikkaa Header-row (Otsikkorivi) -pompula valituksi.
- Valitse ylimpään Sort By laatikkoon "Uusi Laji"
- Valitse järjestykseksi Descending (Laskeva)
- Älä kajoa muihin laatikoihin
- Klikkaa OK

Poista turhat datat
- Rullaile dataa allaspäin kunnes löydät A-sarakkeesta arvon 0
- Valitse kyseinen rivi rivivalitsimesta
- Paina vaihto näppäin (shift) pohjaan ja pidä se painettuna
- Paina näppäintä end
- Paina näppäintä nuoli alas (valituksi tulevat kaikki "nollarivit")
- Vapauta vaihto näppäin (shift)
- Valitse Edit -valikosta Delete (Muokkaa - Poista).

Järjestä takaisin alkuperäiseen järjestykseen:
- Valitse koko data näppäinkomennolla Ctrl-a (pidä control-nappi pohjassa ja paina a)
- Valitse Data -valikosta Sort (Järjestä)
- Jos ei ole valittuna, niin klikkaa Header-row (Otsikkorivi) -pompula valituksi.
- Valitse ylimpään Sort By laatikkoon "1"
- Valitse järjestykseksi Ascending (Nouseva)
- Älä kajoa muihin laatikoihin
- Klikkaa OK

Poista apusarakkeet
- Valitse sarakevalitsimista sarakkeet A ja B
- Valitse Edit -valikosta Delete (Muokkaa - Poista).

Oikeasti tätä ei ole ollenkaan vaikea tehdä...

- PekkaS -

Kiitti, tälläkin tosiaan asian voi hoitaa. Ohje on niin perusteellinen, että hirvittää :))

Tietysti kiinnostaisi, jos joku jaksaa vielä ohjelmoida saman..........

jjuju kirjoitti:Tietysti kiinnostaisi, jos joku jaksaa vielä ohjelmoida saman..........

Toimisikohan tämä.

Koodi: Valitse kaikki

Sub TIIRAN_HAVIKSET_LAJILISTA()
'Makro hakee kustakin lajista vanhimman havainnon.
'Versio 1.00 12.5.2008
'
'Pekka Suopajärvi 12.5.2008

'   Etsitään viimeinen datarivi
    Columns("A:A").Select
    Set RowValue = Selection.Find(What:="", After:=Range("A1"), _
    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext)
    LastRow = RowValue.Row - 1

'   Lisätään rivinumero uuteen sarakkeeseen rivijärjestyksen pitämiseksi
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("A2:A" & LastRow).Select
    Selection.FillDown
    
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False

'   Järjestetään data laji- ja päivämääräjärjestykseen
    Cells.Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, _
    	Key2:=Range("D2"), Order2:=xlAscending, Header:=xlYes, _
    	OrderCustom:=1, MatchCase:= False, Orientation:=xlTopToBottom, _
    	DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

'   Poista rivi jos laji sama
    rw = 2
    While rw <= LastRow
        If Cells(rw, 3) = Cells(rw - 1, 3) Then
            Rows(rw).Delete Shift:=xlUp
            LastRow = LastRow - 1
        Else
            rw = rw + 1
        End If
    Wend
    
'   Palauta alkuperäinen järjestys ja poista rivinumerosarake
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    
End Sub

Hyvin tuntui toimivan, kun kokeilin suurella Excel-tiedostolla (4346 riviä haviksia). Macron ajaminen kesti yli minuutin, mutta hyvin tuntuisi pelaavan. Kiitos jälleen kerran!

Tiirafoorumi

CSV-ladattujen tiedostoille "ensihavaintomakro"

CSV-ladattujen tiedostoille "ensihavaintomakro"

Re: CSV-ladattujen tiedostoille "ensihavaintomakro"

Kiitos

Re: Kiitos

Kiitos!