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

812

Äänestä

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

    • kunde

      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.

      • kunde
        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ä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Orpo hiiri kadoksissa, Marin jo kommentoi

      Kuinka on valtiojohto hukassa, kun vihollinen Grönlantia valloittaa? Putinisti Purra myös hiljaa kuin kusi sukassa.
      Maailman menoa
      65
      4859

    2. Lopeta jo pelleily, tiedän kyllä mitä yrität mies

      Et tule siinä onnistumaan. Tiedät kyllä, että tämä on just sulle. Sä et tule multa samaan minkäänlaista responssia, kosk
      Ikävä
      273
      3736

    3. Tampereen "empatiatalu" - "Harvoin näkee mitään näin kajahtanutta"

      sanoo kokoomuslainen. Tampereen kaupunginvaltuuston maanantain kokouksessa käsiteltävä Tampereen uusi hyvinvointisuunni
      Maailman menoa
      288
      3420

    4. Tehomaksu rankaisisi normaalista sähkönkäytöstä

      Energiaviraston valmistelema tehomaksumalli herättää aiheellista huolta erityisesti tavallisten kotitalouksien näkökulma
      Maailman menoa
      115
      3295

    5. Nuori lapualainen nainen tapettu Tampereella?

      Työ­matkalainen havahtui erikoiseen näkyyn hotellin käytävällä Tampereella – tämä kaikki epäillystä hotelli­surmasta tie
      Lapua
      34
      2780

    6. Lidl teki sen mistä puhuin jo vuosikymmen sitten

      Eli asiakkaat saavat nyt "skannata" ostoksensa keräilyvaiheessa omalla älypuhelimellaan, jolloin ei tarvitse mitään eril
      Maailman menoa
      127
      1748

    7. Miten kuvailisit kaivattusi ulkonäköä....

      ..sun ystäville?
      Ikävä
      105
      1610

    8. Leo Meller on kuollut

      Mtä sääntöjen vastaista Mellerin kuolemassa?
      Helluntailaisuus
      172
      1251

    9. Orpo pihalla kuin lumiukko

      Onneksi pääministerimme ei ole ulkopolitiikassa päättäjiemme kärki. Hänellä on täysin lapsellisia luuloja Trumpin ja USA
      Kansallinen Kokoomus
      86
      1142

    10. Toimari laittoi afrikkalaiset työharjoittelijat laulamaan Banaaninlastaajan laulua!

      Käski vielä heidän sanoa aina aamulla tehtävien jaossa "tama ei olla valkoisen miehen homma."
      Maailman menoa
      34
      1081
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt