Keskustelu: Ohjelmointikysymykset: VBA: Excel: rivien haku -macro

kemospetrol [16.07.2009 12:15:32]

Morjensta,

Tarvis tehdä exceliin macro, jolla pystyisi kopiomaan ja lajittelemaan yhdeltä välilehdeltä tietyt ehdot täyttäviä rivejä toisille välilehdille. Lähde välilehti voisi näyttää esim tältä:

C D E F
5 ha audi a4 1,8
6 mp audi x1 1,6
7 ha audi a3 2
8 pa toyota dyna 2,4
9 pa toyota hiace 2,6

Ja lopputuloksena olisi seuraavanlaiset välilehdet:

Audi henkiloautot-välilehti

B C D
3 1,8 audi a4
4 2 audi a3

Toyota pakettiautot-välilehti:

B C D
3 2,4 toyota dyna
4 2,6 toyota hiace

Macro siis tarkastaisi lähde välilehden sarakkeet C ja D ja jos ne kelpaavat, kopioidaan rivi oikealle välilehdelle, ja vielä siten että sarakkeiden paikka on vaihtanut. Minkälaisella koodilla tulisi lähteä liikkeelle?

Teuro [16.07.2009 12:21:35]

Entäpä sitten kun merkkejä ja malleja on monta kappaletta? Tuleeko jokaiselle merkille oma välilehti? Toimisiko Excelin oma suodatus paremmin, koska sen voi tehdä jokaisen otsikon mukaisesti. Ainakin siis 2007 versiossa vanhemmista en ole varma.

kemospetrol [16.07.2009 12:35:01]

No jos näitä vaihtoehtoja ei olisi kuin muutama..

Grez [16.07.2009 13:08:47]

En näe kyllä tuossa alkuperäisen idean mukaisessa toteutuksessa mitään ihmeempiä ongelmia.

Eli:
- looppaa alkuperäisen lehden rivit läpi
- valitse merkkiä ja tyyppiä vastaava lehti, jos ei, lisää ja valitse uusi
- kopioi rivin tiedot valitun lehden ensimmäiselle tyhjälle riville.

Tai toinen vaihtoehto:
- Sorttaa alkuperäiset tiedot
- Looppaa rivit läpi
- jos merkki ja tyyppi eri kuin edellisellä rivillä, tee uusi lehti
- kopioi rivi lehdelle

kemospetrol [16.07.2009 13:25:46]

Tällaisen koodin pätkän löysin aikaisemmista viestiketjuista. Saisko tästä jotenkin muokattua tähän käyttöön sopivan. Ohjelmointitaitoni, kun ovat "hieman" hukassa?

Private Sub CommandButton1_Click()
  Dim taulu, solu
  Application.ScreenUpdating = False
  Sheets("Taul3").Range("A1:" + Sheets("Taul3"). _
  Cells.SpecialCells(xlCellTypeLastCell).Address).Select
  Selection.Clear
  For Each taulu In Sheets
    If taulu.Name <> "Taul3" Then
      For Each solu In taulu.Range("A1:A" + _
      CStr(taulu.Cells.SpecialCells(xlCellTypeLastCell).Row))
        If solu.Value = "Matti" Then
          i = i + 1
          taulu.Range("A" + CStr(solu.Row) + ":D" + _
          CStr(solu.Row)).Copy Destination:=Sheets( _
          "Taul3").Range("A" + CStr(i) + ":D" + CStr(i))
        End If
      Next
    End If
  Next
  Application.ScreenUpdating = True
End Sub

neau33 [16.07.2009 20:01:02]

Moikka kemospetrol!

oheinen esimerkki mukailee alkuperäisen kysymyksesi mallia...

Private Sub CommandButton1_Click()

     Dim taulu, solu
     Dim rivit, merkki, luokka, vlehti

     '"Kaikki autot" on lähdetaulun nimi
     rivit = Sheets("Kaikki autot").UsedRange.Cells. _
     SpecialCells(xlCellTypeLastCell).Row


     For Each solu In Sheets("Kaikki autot").Range("D1:D" + CStr(rivit))

        luokka = ""

        Select Case solu.Value
            Case "ha": luokka = "henkilöautot"
            Case "pa": luokka = "pakettiautot"
            'jne.
        End Select

        If luokka <> "" Then

            Dim alku, loppu, rivix

            merkki = Cells(solu.Row, 5).Value
            alku = UCase(Left(merkki, 1))
            loput = LCase(Right(merkki, Len(merkki) - 1))
            vlehti = alku + loput + " " + luokka

            rivix = Sheets(vlehti).UsedRange.Cells. _
            SpecialCells(xlCellTypeLastCell).Row

            If rivix < 3 Then
                rivix = 3
            Else
                rivix = rivix + 1
            End If

            Sheets(vlehti).Cells(rivix, 2).Value = _
            Cells(solu.Row, 7).Value
            Sheets(vlehti).Cells(rivix, 3).Value = _
            Cells(solu.Row, 5).Value
            Sheets(vlehti).Cells(rivix, 4).Value = _
            Cells(solu.Row, 6).Value

        End If

    Next

End Sub

neau33 [17.07.2009 02:31:25]

Moikka taas kemospetrol!

tässä vielä samaa tarkistusrutiinilla & kommentoituna

Private Sub CommandButton1_Click()

     ' alustetaan muuttujat (Variant-tyyppisiksi)
     Dim taulu, solu
     Dim rivit, merkki, luokka, vlehti

     ' poimitaan lähdetaulun käytössä olevan
     ' alueen viimeisen rivin indeksiarvo
     ' ja sijoitetaan arvo muuttujaan 'rivit'
     rivit = Sheets("Kaikki autot").UsedRange.Cells. _
     SpecialCells(xlCellTypeLastCell).Row

     ' käydään silmukassa läpi kaikki lähdetaulun
     ' C sarakkeen solut ensimmäiseltä riviltä
     ' käytössä olevan alueen viimeiselle riville
     For Each solu In Sheets("Kaikki autot"). _
     Range("C1:C" + CStr(rivit))

        ' asetetaan jokaisella kierroksella
        ' merkijonomuuttujan 'luokka' arvoksi
        ' tyhjä merkkijono
        luokka = ""

        ' annetaan ehtolauserakennelmassa
        ' arvo muuttujalle 'luokka', muuttujan
        ' 'solu' kulloisenkin arvon perusteella
        Select Case solu.Value
            Case "ha": luokka = "henkilöautot"
            Case "pa": luokka = "pakettiautot"
            'jne.
        End Select

        ' jos muuttujan 'luokka' arvoksi on saatu
        ' muu kuin tyhjä merkkijono niin...
        If luokka <> "" Then

            'alustetaan lisää muuttujia
            Dim alku, loppu, rivix, vertaa

            merkki = Cells(solu.Row, 4).Value

            ' poimitaan merkkijonosta 'merkki' ensimmäinen
            ' merkki, muutetaan isoksi kirjaimeksi
            ' ja sijoitetaan arvo muuttujaan 'alku'
            alku = UCase(Left(merkki, 1))

            ' pomitaan samasta merkkijonosta loput
            ' merkit, muutetaan pieniksi kirjaimiksi
            ' ja sijoitetaan arvo muuttujaan 'loput'
            loput = LCase(Right(merkki, Len(merkki) - 1))


            ' sijoitetaan merkkijonojen yhdistelmä
            ' muuttujan 'vlehti' arvoksi, jolloin
            ' muutujan arvoa voidaan käyttää viitatessa
            ' nimellä välilehteen (= Työkirjan taulu)
            vlehti = alku + loput + " " + luokka


            ' poimitaan kohdetaulun käytössä olevan
            ' alueen viimeisen rivin indeksiarvo
            ' ja sijoitetaan muuttujan 'rivix' arvoksi
            rivix = Sheets(vlehti).UsedRange.Cells. _
            SpecialCells(xlCellTypeLastCell).Row

            ' alustetaan boolean-tyyppinen muuttuja
            Dim taulussa As Boolean

            'tarkistetaan onko lähdetaulusta kulloinkin
            'poimittavat tiedot jo mahdollisesti kohdetaulussa
            For i = 1 To rivix
                If Sheets(vlehti).Cells(i, 2) = _
                Cells(solu.Row, 6).Value _
                And Sheets(vlehti).Cells(i, 3) = _
                Cells(solu.Row, 4).Value And _
                Sheets(vlehti).Cells(i, 4) = _
                Cells(solu.Row, 5).Value Then
                    ' ja jos ovat niin asetetaan
                    ' boolean muuttujan arvoksi TOSI
                    ' ja poistutaan silmukasta
                    taulussa = True: Exit For
                End If
            Next i

            ' Jos muuttujan arvo on EPÄTOSI...
            If Not taulussa Then

                ' ja kohdetaulun käytössä olevan
                ' alueen viimeinen rivi < 3
                If rivix < 3 Then
                    ' asetetaan viimeistä riviä
                    ' osittavan muuttujan arvoksi 3
                    rivix = 3
                Else
                    ' muutoin kasvatetaan muuttujan arvoa
                    ' yhdellällä (viimeinen rivi + 1)
                    rivix = rivix + 1
                End If

                ' ja sijoitetaan lähdetaulusta muuttujan 'solu'
                ' sisältämän rivi-indeksin ja suoran sarakeindeksi-
                ' viitauksen avulla tiedot kohdetaulussa haluttuhin
                ' sarakkeisiin muuttujan 'rivix' osoittamalle riville
                ' käyttäen suoraa sarakeindeksiviittausta
                Sheets(vlehti).Cells(rivix, 2).Value = _
                Cells(solu.Row, 6).Value
                Sheets(vlehti).Cells(rivix, 3).Value = _
                Cells(solu.Row, 4).Value
                Sheets(vlehti).Cells(rivix, 4).Value = _
                Cells(solu.Row, 5).Value

            End If

        End If

    Next

End Sub

kemospetrol [20.07.2009 09:03:05]

Morjensta Nea

Kiitoksia avuista ja yksityiskohtaisesta koodin salojen selostuksesta. En kuitenkaan saa tällä Macroa toimimaan.. Saan virhe ilmoituksen:

Run-time error '9': subscript out of range

ja debugger jymähtää kohtaan:

rivix = Sheets(vlehti).UsedRange.Cells. _
SpecialCells(xlCellTypeLastCell).Row

Mikähän avuksi?

kemospetrol [20.07.2009 13:57:31]

Ähh.. kyllähän tuo toimii niinkuin on tarkoitettukin, käyttäjässä vain taitaa hieman olla. Tuli hitusen muutoksia alkuperäiseen taulukkoon. Mites saisin tälläisen "kaikki autot" -syötesivun lajiteltua uusille välilehdille:

B C D E
3 x x audi automaatti
4 x skoda automaatti
5 x x ww automaatti
6 x x mb automaatti
7 x fiat manuaali
8 x x fiat manuaali
9 x x audi manuaali
10 x x alfa automaatti

siten että, jos sarakkeissa B ja C olevat ruksilla merkityt kummatkin lisävarusteet löytyvät kopioidaan ja lajitellaan auton tiedot (merkki ja vaihteiston tyyppi) vaihteiston tyypin perusteella omille välilehdille "automaatti" ja "manuaali" siten että automerkit tulee välilehdille aakkosjärjestyksessä.

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Kilpailu