teksti sarakkeisiin

pom

Pitäisi saada b-sarakkeessa oleva teksti sarakkeisiin, niin että muotoilut säilyisivät. Erottimena toimii välilyönti.

"Teksti sarakkeisiin" ja "poimi.teksti" poistaa muotoilut...

Kiitos avusta!

5

774

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • paavali50

      Kopioi ensin B-sarakkeen muotoilut niihin sarakkeisiin joihin teksti "leviää".
      Joko Kopioi -> liitä määräten -> muotoilut ja OK, tai muotoilusiveltimellä.
      Sitten vain teksti sarakkeisiin..

    • moduuliin...

      Sub TekstiSiirto()
      Dim vika As Integer
      Dim a As Variant
      On Error Resume Next
      Application.ScreenUpdating = False
      vika = Range("B65536").End(xlUp).Row
      For Each solu In Range("B1:B" & vika)
      a = Split(solu, " ") ' erottimena välilyönti
      For i = 1 To UBound(a) 1
      solu.Copy
      solu.Offset(0, i 1).PasteSpecial Paste:=xlPasteFormats
      solu.Offset(0, i 1) = a(i - 1)
      Next
      Next
      Application.CutCopyMode = False
      Application.ScreenUpdating = True
      End Sub

      • pom

        toiminut kummallakaan tavalla niin kuin piti...

        B-sarakkeessa oleva teksti on lyhenteitä (1-4 kirjainta ja lyhenteitä on 21 kpl), jotka on muotoiltu eri värein. Eli samassa "rimpsussa" saattaa olla useita värejä. Värien järjestys ei ole sama joka rivillä.
        Nyt molemmat tavat muotoili tekstin ensimmäisen lyhenteen mukaan.


      • pom kirjoitti:

        toiminut kummallakaan tavalla niin kuin piti...

        B-sarakkeessa oleva teksti on lyhenteitä (1-4 kirjainta ja lyhenteitä on 21 kpl), jotka on muotoiltu eri värein. Eli samassa "rimpsussa" saattaa olla useita värejä. Värien järjestys ei ole sama joka rivillä.
        Nyt molemmat tavat muotoili tekstin ensimmäisen lyhenteen mukaan.

        etpähän maininnut alkujaan, että solussa useampi muotoilu...
        no nyt koodi tekee haluamasi

        Sub TekstiSiirto()
        Dim vika As Integer
        Dim a As Variant
        Dim Alku As Integer
        Dim Pituus As Integer
        On Error Resume Next
        Application.ScreenUpdating = False
        vika = Range("B65536").End(xlUp).Row

        For Each solu In Range("B1:B" & vika)
        a = Split(solu, " ") ' erottimena välilyönti
        Alku = 1
        For i = 1 To UBound(a) 1
        Pituus = Len(a(i - 1))
        väri = solu.Characters(Start:=Alku, Length:=Pituus).Font.ColorIndex
        solu.Offset(0, i) = a(i - 1)
        solu.Offset(0, i).Characters(Start:=1).Font.ColorIndex = väri
        Alku = Alku Pituus 1
        Next
        Next
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        End Sub


      • pom
        kunde kirjoitti:

        etpähän maininnut alkujaan, että solussa useampi muotoilu...
        no nyt koodi tekee haluamasi

        Sub TekstiSiirto()
        Dim vika As Integer
        Dim a As Variant
        Dim Alku As Integer
        Dim Pituus As Integer
        On Error Resume Next
        Application.ScreenUpdating = False
        vika = Range("B65536").End(xlUp).Row

        For Each solu In Range("B1:B" & vika)
        a = Split(solu, " ") ' erottimena välilyönti
        Alku = 1
        For i = 1 To UBound(a) 1
        Pituus = Len(a(i - 1))
        väri = solu.Characters(Start:=Alku, Length:=Pituus).Font.ColorIndex
        solu.Offset(0, i) = a(i - 1)
        solu.Offset(0, i).Characters(Start:=1).Font.ColorIndex = väri
        Alku = Alku Pituus 1
        Next
        Next
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        End Sub

        huono alustus!

        Nyt tekee mitä pitääkin. Suuret kiitokset!


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

    Luetuimmat keskustelut

    1. Anteeksi mies

      En vaan osaa kohdata sinua ja olla normaali. En tiedä mikä vaivaa. Samaan aikaan tekee mieli tulla lähelle ja kuitenkin
      Ikävä
      58
      9797
    2. Mietin aina vain

      Minä niin haluaisin nähdä sinut. Ei tuo yhden ainoan kuvan katsominen paljon helpota... Miksi sinä et voisi olla se roh
      Tunteet
      17
      4081
    3. Hetken jo luulin, että en ikävöi sinua koko aikaa

      Mutta nyt on sitten taas ihan hirveä ikävä jotenkin. Tiedätköhän sinä edes, kuinka peruuttamattomasti minä olen sinuun r
      Ikävä
      32
      3356
    4. Kysely lieksan miehille

      Olemme tässä pohtineet tällaista asiaa, että miten on. Tästä nyt on paljon ollut juttua julkisuudessakin aina sanomaleht
      Lieksa
      94
      2633
    5. Palstan henkisesti sairaat ja lihavat

      Täällä on sairaita, työttömiä ihmisiä kirjoittelemassa joilla ei ole tarkoituksena kuin satuttaa ihmisiä. Jos eksyt pals
      Ikävä
      114
      2110
    6. Outoa että Trump ekana sanoutui irti ilmastosopimuksesta

      kun Kaliforniaa riepottelee siitä johtuvat tuhoisat maastopalot. Hirmumyrskytkin ovat USA:ssa olleet tuhoisia.
      Maailman menoa
      400
      2030
    7. Saan kengurakkaan kotiin viikon päästä

      Mitä tapahtui? Martina hehkutti tätä stoorissaan reilu viikko sitten, mutta eipä aussimiestä Suomessa näkynyt, vaan tapa
      Kotimaiset julkkisjuorut
      244
      1535
    8. FinFamin ryhmät

      Älkää hyvät ihmiset luottako tähän tahoon. Ryhmiä on, mutta eivät ne toimi. Ihmisiä savustetaan ulos, vaikka näissä piir
      Salo
      0
      1351
    9. Osmo Peltola voitti ansaitusti Kultaisen Venlan - Kirvoitti yleisöltä mahtavan reaktion!

      JEE, onnea Osmo! Osmo Peltola voitti Vuoden esiintyjän Kultainen Venla -palkinnon. Isä-Peltsin ja Osmon luontoseikkailu
      Suomalaiset julkkikset
      73
      1178
    10. Olen vähän

      Hysteerinen se on totta. Etkai ymmärrä miten syvästi tunnen sinua kohtaan. Ja olet aina lähelläni. Olet osa jo jotain. I
      Ikävä
      10
      1135
    Aihe