Pikkumakro tai kaava: pilkun jälkeen rivinvaihto

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

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

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

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.

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

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...

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

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.

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

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.

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

tuolta voi ladata ton mun mallitiedoston
https://www.dropbox.com/s/2u3dcu9dyk150n8/Rivittää solun.rar?dl=0