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

809

    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. Marin sitä, Marin tätä, yhyy yhyy, persut jaksaa vollottaa

      On nuo persut kyllä surkeaa porukkaa. Edelleen itkevät jonkun Marinin perään, vaikka itse ovat tuhonneet Suomen kansan t
      Maailman menoa
      127
      3752
    2. Ikävä sinua..

      Kauan on aikaa kulunut ja asioita tapahtunut. Mutta sinä M-ies olet edelleen vain mielessäni. En tiedä loinko sinusta va
      Ikävä
      15
      1717
    3. Riikka Purra: "Kokoomus haluaa leikata pienituloisten etuuksista - Se ei meille käy"

      Näin vakuutti persujen Purra edellisten eduskunta vaalien alla,. https://www.ku.fi/artikkeli/4910942-kun-uudessa-videos
      Maailman menoa
      15
      1561
    4. Riikka Purra sanoo, että sietokykyni vittumaisiin ihmisiin alkaa olla lopussa.

      https://www.iltalehti.fi/politiikka/a/be8f784d-fa24-44d6-b59a-b9b83b629b28 Riikka Purra sanoo medialle suorat sanat vitt
      Maailman menoa
      296
      1406
    5. Muistattekos kuinka persujen Salainen Akentti kävi Putinin leirillä

      Hakemassa jamesbondimaista vakoiluoppia paikan päällä Venäjällä? Siitä ei edes Suomea suojeleva viranomainen saanut puhu
      Maailman menoa
      18
      1396
    6. Lindtmanin pääministeriys lähenee päivä päivältä

      Suomen kansan kissanpäivät alkavat siitä hetkestä, kun presidentti Stubb on tehnyt nimityksen. Ainoastaan ylin tulodesi
      Maailman menoa
      30
      1289
    7. Tuntuuko sinusta mies

      että olet jossain, mutta sydämessäsi haluat olla muualla. Suunnittelet kaikkea kivaa ja olet innolla mukana, mutta silti
      Ikävä
      16
      974
    8. Kapiainen siviiliesimies, Herra suuri Herra

      Sotilaana kyvytön, johtajana munaton ja kotona tossun alla. Se on upseerin uran tuen pää, seinään ajo. Mutta aina löytyy
      Sodankylä
      72
      953
    9. Väärä pää tutustumiseen

      Mikä ihme on, että miehet haluavat ensimmäisenä sänkyyn? Onko nykyään niin helppo saada nainen peittojensa alle.. tai pä
      Ikävä
      126
      916
    10. Mitä tapahtuisi....

      Meidän välillä jos törmäisimme yöelämässä ilman häiriötekijöitä ja olisimme hieman huppelissa? Päättyisikö ilta kenties
      Ikävä
      60
      829
    Aihe