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

1391

    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. Milloin olet viimeksi nähnyt

      Kaivattusi ja missä? Onko ikävä vastaa rehellisesti.
      Ikävä
      132
      2091
    2. Onpas punavihreät taas ärhäkkäinä

      😺 Ihan tuntuu kuin syyttäisitte meikäläisiä/meikäläistä Oulun puukotuksesta. Tapaus on hyvin ikävä ja tuomittava. En
      Luterilaisuus
      375
      1558
    3. Hauskaakin jopa...

      Että moni nainen olettaa, että kyse on vaan siitä kaanustinloukusta, kun mies jotain ehdottaa. 😄 Ja miettiikö monikaan
      Sinkut
      227
      1166
    4. Nainen, minkä kappaleen laittaisit nyt miehelle

      kuunneltavaksi tietäen, että hän ikävöi sinua ja kipuilee päästäkseen yhteyteen kanssasi. Jotain, joka kertoo...
      Ikävä
      108
      972
    5. Koen, että minua tavallaan vainotaan

      Kyllä minä vain satun tietämään, että täälläkin on joitain serkun kaiman kummeja jotka kiusaavat minua. Lisäksi sairas n
      Ikävä
      126
      969
    6. Toivottavasti vielä kohdataan mies

      Ja aloitetaan juttelu. Nyt olisin valmis.
      Ikävä
      92
      933
    7. Vanhemmalle naiselle

      Aikataulu muutos. Ensi viikolla pistetään asia vireille. Ei juhannukseen asti aikaa. Kannatti valehdella!
      Ikävä
      55
      918
    8. Herätänkö minä sinut itkullani nainen

      Kysyn tässä kun kaipuun aallot lyövät ylitseni ja ihmettelen missä olet toivoessani, että olisit tässä vierelläni. On va
      Ikävä
      25
      848
    9. Vastaa nyt kun kuitenkin valvot!

      Vai pelkäätkö että miehesi herää? Ppm:lle 😉
      Ikävä
      111
      798
    10. Pimahdan kohta ihan kunnolla

      Entä, jos otan sitten yhteyttä sinuun? 🫨🫥🥴
      Ikävä
      20
      794
    Aihe