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

1623

    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. Saako hän helposti sinut syttymään?

      Kysymys ihanalle tutulle naiselle. Intohimo, erotiikkaa...
      Ikävä
      66
      3606
    2. Olet paljon ajatuksissani

      Olen väsynyt tähän. Siihen miten paljon olen tuntenut. Miten epätoivoista kaikki on ollut. Unessa me suudellaan intohimo
      Ikävä
      53
      3484
    3. Taas yksi aamu kun et noussut tuhisten vierestäni

      Saat anteeksi. Ensi vuonna näihin aikoihin herätään lusikassa joka aamu ja et lähde mihinkään ennen kuin on rakasteltu.
      Ikävä
      51
      2817
    4. Sano nyt vieläkö

      Sä tykkäät kaivatustasi?
      Ikävä
      43
      2787
    5. Aikaa on kulunut useampi vuosi

      Siksi en voi ottaa enää yhteyttä
      Ikävä
      15
      2299
    6. Erikan pornoshow antaa huonon kuvan Suomesta

      Jos haluan kokea VHS-videoajan saksalaisen pornoelokuvan kuvastoa ja sanastoa, hankin jostain sellaisen, enkä halua nähd
      Maailman menoa
      224
      1983
    7. Ketä noi esteelliset ovat?

      Niitä täytyy olla useita henkilöitä, jotka ovat epäilyksen alaisia?
      Ähtäri
      7
      1612
    8. En edes tiennyt

      Mitä rakastuminen voi olla ennenkuin kohtasin hänet
      Ikävä
      17
      1610
    9. Ei taida toi nakki enää herätä eloon

      Sinun jälkeesi nainen. Oliko sinulla jotain taikavoimia?
      Ikävä
      66
      1433
    10. Donald Trump HÄVISI sodan - Vladimir Putin VOITTI sodan!

      Trump lupasi luovuttaa maa-alueita sekä vakuutti Putinille, ettei Ukrainasta tule NATO maa! Mitenhän Ivan Puopolo ja Ma
      Maailman menoa
      203
      1414
    Aihe