Pikkumakro tai kaava: pilkun jälkeen rivinvaihto

Perkku2

Hei. Onko olemassa kaavaa tai saako makrolla aikaan rivinvaihdon, kun solussa on pilkku.

Solussa on aina noin kymmenen nimeä pilkulla eroteltuina. Rivinvaihto tarvitaan merkkien "pilkku ja välilyönti jälkeen" aina siis uuden nimen alussa.

Näitä nimiä sisältäviä soluja on paljon... Makroharjoitukset ovat jääneet unholaan.

Kiitos avusta.

13

1405

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Kundepuu

      fiksaa sopivaksi...

      Sub Rivitä()
      Dim Nimet
      Dim Rivitetty As String
      Dim i
      Dim solu As Range
      'tähän solualue nyt F1:F10 tai sitten vika=... tyylillä tai selection jne
      'sitten loopilla läpi solut
      For Each solu In Range("F1:F10")
      Rivitetty = ""
      Nimet = Split(solu, ",")
      For i = 0 To UBound(Nimet)
      Rivitetty = Rivitetty & Nimet(i) & vbNewLine
      Next
      solu = Left(Rivitetty, Len(Rivitetty) - 1)
      Next
      End Sub

    • Kundepuu

      tyhjä pois riviln alusta
      fiksaa koodissa
      Rivitetty = Rivitetty & Trim(Nimet(i)) & vbNewLine

    • Perkku2

      Suuret kiitokset. Nyt tiedän, mitä alan taas harjoitella.

    • Perkku2

      Nyt olen saanut kaikki nimet omiin riveihinsä samaan soluun, mutta enhän saanutkaan silti nimiluetteloa aikaan, vaikka niin kuvittelin. Nimien pitäisikin olla omissa soluissaan.

      Onnistuisiko vielä tämä? Nimisoluja edeltävän tiedon täytyy tietenkin kopioitua kaikkiin uusiin riveihin.

      Kiitos jos viitsit vielä auttaa.

    • Kundepuu

      ilmeisesti tiedot yhdessä sarakeessa?
      "Nimisoluja edeltävän tiedon täytyy tietenkin kopioitua kaikkiin uusiin riveihin."
      Mitä tarkoitanee?

    • Perkku2

      Nimiä sisältävät solut ovat sarakkeessa F. A-E -sarakkeissa on tietoa, joka on sama jokaista allekkain olevaa nimeä kohti, jotka nyt siis haluaisinkin jokaisen omaan soluunsa ja soluriviinsä.
      F-sarakkeen nimisoluissa on nyt allekkain 6-22 nimeä. Eli jokaista nimisolua kohti tulee 6-22 uutta riviä.
      Saamalla tiedot tähän järjestykseen, voinkin sitten lajitella ja kaivaa niistä vaikka mitä tietoa, sen lisäksi, että saan tulostettua nimilistan.

      Aloitin kopioinnin käsipelein, mutta homma on loputon...

    • Kundepuu

      tietenkin vosi jättää taulukoksikin, jolloin olisi suodatusnapit valmiina... ;-)
      ei tietoa oliko otsikkorivi
      helppo fiksailla

      Sub Rivitä()
      Dim Nimet
      Dim Rivitetty As String
      Dim i As Long
      Dim j As Long
      Dim solu As Range
      Dim vika As Long
      Dim rivi As ListRow
      Dim tb As ListObject
      'On Error Resume Next

      vika = Range("F65536").End(xlUp).Row
      ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:F" & vika), , xlNo).Name = "Nimilista"
      Set tb = ActiveSheet.ListObjects("Nimilista")
      For j = tb.ListRows.Count To 1 Step -1
      Rivitetty = ""
      Nimet = Split(tb.DataBodyRange.Cells(j, tb.ListColumns("Column6").Index), ",")
      tb.DataBodyRange.Cells(j, tb.ListColumns("Column6").Index) = Trim(Nimet(0))
      For i = 1 To UBound(Nimet)
      tb.ListRows.Add (j i)
      tb.DataBodyRange.Cells(j i, tb.ListColumns("Column6").Index) = Trim(Nimet(i))
      tb.DataBodyRange.Cells(j i, tb.ListColumns("Column1").Index) = tb.DataBodyRange.Cells(j, tb.ListColumns("Column1").Index)
      tb.DataBodyRange.Cells(j i, tb.ListColumns("Column2").Index) = tb.DataBodyRange.Cells(j, tb.ListColumns("Column2").Index)
      tb.DataBodyRange.Cells(j i, tb.ListColumns("Column3").Index) = tb.DataBodyRange.Cells(j, tb.ListColumns("Column3").Index)
      tb.DataBodyRange.Cells(j i, tb.ListColumns("Column4").Index) = tb.DataBodyRange.Cells(j, tb.ListColumns("Column4").Index)
      tb.DataBodyRange.Cells(j i, tb.ListColumns("Column5").Index) = tb.DataBodyRange.Cells(j, tb.ListColumns("Column5").Index)
      Next
      Next
      tb.TableStyle = ""
      tb.Unlist
      Range("A1:F1") = ""
      vika = Range("F65536").End(xlUp).Row
      Range("A2:F" & vika).Cut Range("A1")
      Range("A:F").Columns.AutoFit
      End Sub

    • Perkku2

      Moi taas.
      Nyt tyssää riviin: Nimet = Split(tb.DataBodyRange.Cells(j, tb.ListColumns("Column6").Index), ",")

      Kun mainitsin nimilistan, en varsinaisesti tarkoittanut listaa, vaan exceliä, jossa nimet on allekkain omissa soluissaan. Lähetän sen painotaloon, että tuote painetaan jokaiselle henkilölle omalla nimellä. Taulukko on se mihin lopulta kuitenkin pyrin, kun pyysin lisäapua.

      Olen pahoillani, etten osannut olla tarkka sepustuksissani. Tästä tuli sulle nyt kauheasti turhaa vaivaa, anteeksi! Selviän tästä lopusta kyllä kopioi-liitä-menetelmälläkin ajan kanssa.

      Eka lähettämäsi rivitys-makro tulee jatkuvaan käyttöön joka tapauksessa.

    • Kundepuu

      alussa nimet oli samassa solussa pilkulla eriteltynä ja nyt ne on allekkain eri soluissa...
      Koodi purkaa nimet , JOS ne on samassa solussa ja toi virhe syntyy nyt kun ei ole purettavaa.
      Aja viimeinen makro alkuperäiseen (nimet samassa solussa pilkulla eriteltynä ja toimii

    • Perkku2

      Olen koettanut useita kertoja ohjeesi mukaan, mutta aina se jää siihen samaan kohtaan. Taulukko syntyy, mutta nimet jäävät F-sarakkeen soluihin pilkulla eroteltuina.

      Ehkä teen jotain väärin. Toimin näin:
      poistin otsakkeet, tallensin xlsm:nä,
      avasin vba-editorin, ja view - code, liitin kopioidun koodin ja run.

      Sitten avautuu laatikko : runtime error 9, subscript out of range.

      Olen yrittänyt monta kertaa aina uuteen taulukkoon.

    • Kundepuu

      lähetä malli hmetso(at)hotmail.com niin tsekkaan

    • Eli tarkoitus on saada siis soluissa olevat pilkku-välilyönti -yhdistelmällä erotellut merkkijonot omiin soluihinsa?

      Alla oleva makro pilkkoo valituissa soluissa olevat em. tavalla. Muuttuja "pilkkoja" sisältää merkkijonon, jonka perusteella solujen arvot erotellaan toisistaan. Tässä tapauksessa siis ", " eli pilkku ja välilyönti.

      Makro toimii niin että ensin käydään silmukassa läpi kuinka monta arvoa on tulossa yhteensä ja varataan sen kokoinen VBA-merkkijonotaulukko. Seuraavaksi kopioidaan toisessa silmukassa jokaisesta solusta mahdolliset alimerkkijonot aikaisemmin varattuun taulukkoon. Viimeiseksi avataan uusi työkirja, jonka A-sarakkeen riveille kopioidaan arvot varatusta koontitaulukosta.

      ==========================================
      Sub pilkkoja()
          Dim tulokset As Workbook
          Dim pilkottuja As Integer
          Dim pilkotut() As String
          Dim apulista() As String
          Dim pilkkoja As String
        
          pilkkoja = ", "
          
          If Selection.Count > 0 Then
              pilkottuja = 0
              For Each solu In Selection
                  apulista = Split(solu.Text, pilkkoja)
                  If UBound(apulista) > 0 Then
                      pilkottuja = pilkottuja UBound(apulista) 1
                  End If
              Next
              If pilkottuja > 0 Then
                  ReDim pilkotut(pilkottuja)
                  pilkottuja = 0
                      For Each solu In Selection
                          apulista = Split(solu.Text, pilkkoja)
                          If UBound(apulista) > 0 Then
                              For Each elementti In apulista
                                  pilkotut(pilkottuja) = elementti
                                  pilkottuja = pilkottuja 1
                              Next
                          End If
                      Next
                  pilkottuja = 0
                  Set tulokset = Workbooks.Add
                  Set tulokset = ActiveWorkbook
                  For Each elementti In pilkotut
                      tulokset.Worksheets(1).Range("A1").Offset(pilkottuja, 0) = elementti
                      pilkottuja = pilkottuja 1
                  Next
                  tulokset.Worksheets(1).Range("A1:" & Cells(pilkottuja - 1, 1).Address).Select
              End If
          End If
      End Sub

    • Kundepuu

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Moi vaan vielä kerran

      Kivaa päivää samalla. Kukaan ei kaipaa eikä rakasta. 💔🐺🌃🌧️☀️
      Ikävä
      322
      3393
    2. Nainen, millaisista miehistä tykkäät?

      Mielenkiinnosta kysyn 😄
      Ikävä
      212
      2827
    3. Nyt sitten ulos ihmiset!

      Älkää jumittako täällä. Menkää, näkykää ja hankkikaa kokemuksia. Ei teitä kukaan edes bongaile, jos önötätte täällä.
      Ikävä
      144
      2514
    4. Onnea Solatie !

      On sit valittu uusi kaupunginjohtaja.No ei menny Nivala-Harju- Tapio -Pikkarainen juntan mukkaan.
      Kemijärvi
      18
      2029
    5. Mitä jos saisit tietää että kaivatullasi

      on jo joku toinen?
      Ikävä
      109
      2025
    6. Naiselle varatulle

      Jos homma kariutuu kotona, niin saanko sinut ihan omakseni🙂??
      Tunteet
      10
      1696
    7. Minun pitää tehdä jotain

      En tiedä meneekö siihen viikko vai kuukausi. Mutta jos voit odottaa, niin löydän sinut sen jälkeen kun on homma hoidett
      Ikävä
      44
      1672
    8. Sarvisalon kesätori

      Onpa kiva paikka. Mutta torikahvila oli suorastaan naurettavan alkeellinen ja ne voileivät,olivat kuin pienen lapsen tek
      Loviisa
      17
      1578
    9. Sinä oot hyvä ihminen

      Mut ehkä me ei vaa sovita yhteen :(
      Ikävä
      122
      1286
    10. Hindulijat raivoavat täällä, ettei kristinuskossa

      ole itsessään mitään aitoa! No miksi sitten hyökkäilette "nollaa vastaan"? Eikö hnduilijan vaan kannattaisi pieht
      Hindulaisuus
      246
      1231
    Aihe