Minulla on Excel- tietokantoja, jossa on A-sarakkeessa tasoja ilmaisevat luvut 1-6, ja niihin liittyvät tiedot B-sarakkeessa.
Tarkoitus olisi saada aikaan hierarkiapuu, jossa 1. tason tiedot jäisivät B-sarakkeeseen, mutta seuraavat tasot aina yhden sarakkeen oikealle siten että 6. taso tulisi sarakkeeseen G.
Tein ensialkuun painikkeita, joissa oli koodi tyyliin:
Private Sub CommandButton1_Click()
Selection.Cut
ActiveCell.offset(0, 1).Select
ActiveSheet.Paste
End Sub
Painikkeiden käyttö osoittautui kuitenkin työlääksi tietokannan koon ollessa suuri. Suodatetut rivit kun piti valita yksitellen.
Yritin tehdä makroa, mutta taitoni eivät riittäneet.
Siksi käännyn gurujen puoleen, jos vaikka saisin pienen vihjeen homman ratkaisemiseksi.
Hierarkia siirtymä-funktiolla
13
225
Vastaukset
- karvalaggi
Jos tämä on vain kertaluonteinen tapahtuma, tekisin minä näin. Esimerkissäni minulla on soluissa C1:H1 tasoluvut 1-6 (otsikot) ja tiedosto alkaa 2 riviltä. Kaavat:
C2=JOS(A2=1;B2;"")
D2=JOS(A2=2;B2;"")
E2=JOS(A2=3;B2;"")
F2=JOS(A2=4;B2;"")
G2=JOS(A2=5;B2;"")
H2=JOS(A2=6;B2;"")
Valitse hiirellä solut C2:H2. Tuplaklikkaa solun H2 oikeassa alakulmassa olevaa "pallukkaa". Kaavat kopioituvat alaspäin niin pitkälle kuin A/B sarakkeissa on tietoja.
Kopioidut solut jäävät "valituiksi". Suorita "Kopioi". Valitse solu C2 ja liitä määräten (vain arvot). Poista sarake B. Nyt sinulla on jaoteltu tiedot hierarkisesti sarakkeisiin B:G- Puuaivo2
Kiitos. Tuokaltaisen virityksen olin jo tehnyt. Taulukoita on useita, ja niitä päivitetään jatkuvasti. Tarkoitus olisi saada käyttöön makrolla toimiva yleisemmässä käytössä oleva ratkaisu.
- ORCL
moduuliin:
Sub MuokkaaHierarkiapuu()
Dim Taso As Variant
Dim ViimeinenRivi As Integer
Dim i As Integer
ViimeinenRivi = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To ViimeinenRivi
Taso = Cells(i, 1).Value
On Error Resume Next
Select Case Taso
Case 2
Cells(i, 3).Value = Cells(i, 2).Value
Cells(i, 2).ClearContents
Case 3
Cells(i, 4).Value = Cells(i, 2).Value
Cells(i, 2).ClearContents
Case 4
Cells(i, 5).Value = Cells(i, 2).Value
Cells(i, 2).ClearContents
Case 5
Cells(i, 6).Value = Cells(i, 2).Value
Cells(i, 2).ClearContents
Case 6
Cells(i, 7).Value = Cells(i, 2).Value
Cells(i, 2).ClearContents
End Select
Next i
End Sub- Puuaivo2
Kiitos. Tämä toimi hyvin. Sitä on helppo muokata myös laajentuneeseen taulukkoon sopivaksi.
moduuliin...
Sub Siirrä()
Dim Alue As Range
For i = 1 To 6
Set Alue = Etsi(i)
Alue.Offset(0, i 1) = Alue.Offset(0, 1)
Next
Columns("B:B").Delete
End Sub
Function Etsi(Hakuehto As Variant) As Range
Dim solu As Range
Dim EkaOsoite As String
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set Etsi = solu
EkaOsoite = solu.Address
Do
Set Etsi = Union(Etsi, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address <> EkaOsoite
End If
End With
End Function
Keep EXCELing
@Kunde- Puuaivo2
Kiitos. Kunden koodi on kunnianhimoisen näköistä, mutta en saanut sitä toimimaan. Makron suorituksessa tuli seuraavanlainen virheilmoitus:
Microsoft Visual Basic for Applications
Run-time error '91':
Object variable or With block variable not set
- plockare
Minun versiossa valitaan ensin haluttu sarake tai sarakkeesta arvoalue, jossa on ne luvut kuinka etäälle kyseisestä luvusta oikealla olevan solun arvo siirretään. Esimerkiksi tässä tapauksessa valittaisiin sarake A ja ajettaisiin makro.
Makrossa tarkastetaan ensin että valittuna on vain yhden sarakkeen tietoja. Sitten suodatetaan alueen soluista pelkästään positiiviset arvoltaan yli 1 olevat kokonaisluvut. Kun luku kelpaa, niin oikeanpuoleisen solun sisältöä siirretään luvun verran valintasarakkeesta oikealle päin.
Pastebin-linkki jos s24 rikkoo tuon koodin, vaikkei tietysti sisennyksillä ole VBA:ssa mitään merkitystä: http://pastebin.com/m09YQ5WK
Sub siirra()
If Selection.Columns.Count() = 1 Then
For Each cell In Selection
If Len(cell.Value) > 0 Then
If IsNumeric(cell.Value) = True Then
If Int(cell.Value) = cell.Value And cell.Value > 1 Then
cell.Offset(0, 1).Cut cell.Offset(0, cell.Value)
End If
End If
End If
Next
End If
End Subjos valitaan sarake reilut miljoona luuppia tekee, vaikka tarvitsisi esim. 30 riviä käydä läpi ;-)
- Tämmöinen
Jos välilyönnin korvaa sidotulla välilyönnillä, se muuttuu S24:ssä tavalliseksi välilyönniksi joka säilyy. Sidottu välilyönti ( Alt 0160) on suomalaisen standardin (SFS 5966) näppäimistössä Alt välilyönti.
- Puuaivo2
Kiitos. Tämä oli sellainen, että makro piti ajaa joka riviltä erikseen. Ei paljoa eroa omaan nappulaviritykseen.
- plockare
Puuaivo2 kirjoitti:
Kiitos. Tämä oli sellainen, että makro piti ajaa joka riviltä erikseen. Ei paljoa eroa omaan nappulaviritykseen.
Valitsitko varmasti kaikki lukuarvot sisältävän alueen (tai koko sarakkeen) ennen makron ajamista? Tuo käy siis koko valitun alueen läpi. Jos vain yksi solu on valittuna, niin silloin temput tehdään vain sen solun riville.
- Puuaivo2
Ok. Koko alueen valinta tosiaan auttoi. Siihen pitää vielä lisätä alueen valintaa varten koodia.
- plockare
Puuaivo2 kirjoitti:
Ok. Koko alueen valinta tosiaan auttoi. Siihen pitää vielä lisätä alueen valintaa varten koodia.
Joo siihen voi laittaa ensimmäiseksi riviksi vaikka Columns("A:A").Select tai Range("A1:A20").Select, jos alue on aina samassa kohtaa.
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Kuvat! Dannyyn liitetty Helmi Loukasmäki, 22, on puhjennut naisena kukkaan - Some sekoaa: "Sä..."
Ooo, kaunis aikuinen nainen Helmistä on kasvanut siinä yli 80-vuotiaan Dannyn rinnalla! Katso uudet kuvat: https://ww675331- 573565
Suodatinpussin kastelemalla saa parempaa kahvia
Kokeilin niksiä ja kyllä tämä kahvi on parempaa nyt. Ei lainkaan maistu paperiselta. Huljuttelee hanan alla suppiloa pap1502651Tidätkö nainen
että suoraan sanottuna v.tut.aa että pääsit näin lähelle minua. Ei olisi oikeasti aikaa tähän mutta silti aina välillä o1052136Mikä on kaivattusi etunimi?
Otsikossa siis on kysymys eriteltynä. Vain oikeat vastaukset hyväksytään.891822Onkohan sinulla kaikki hyvin?
Nyt vähän sellainen outo tunne tuli. Sinun asiasi niin ei minulle toki tarvitse kertoa. Kunhan mietin...381277Oho! Arja Koriseva paljastaa TTK:n ekasta suorasta lähetyksestä: "On vähän ärsyttävä yhtälö!"
Upea Arja Koriseva! Tsemppiä haasteelliseen tilanteeseen! Lue lisää: https://www.suomi24.fi/viihde/oho-arja-koriseva-211269En kestä katsoa
Sitä miten sinusta on muut kiinnostuneita. Olen kateellinen. Siksi pitäisi lähteä pois961228Huikeeta, mahtavaa, ihan mielettömän upeeta
Me ostettiin talo Espanjasta. Tosin saadaan käyttää sitä vain muutama viikko vuodessa kun on monta muutakin ostajaa! M1951202- 1731136