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

788

Ää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. Mies vinkkinä sulle

      Jos pyytäisit kahville tai ihan mihin vaan, niin lähtisin varmasti välittämättä muista
      Ikävä
      99
      7853

    2. Oletko katkera kun

      Et saanut kaivattuasi
      Ikävä
      107
      5617

    3. Mitä haluat sanoa tällä hetkellä

      Hänelle 🫶 ⬇️
      Ikävä
      275
      4881

    4. Haluun sua niin paljon

      ❤️🥰🥹 Miehelle
      Ikävä
      49
      4843

    5. Vietetään yö yhdessä

      Rakastellaan koko yö
      Ikävä
      76
      3607

    6. Mitä palveluita mies..

      Haluaisit tilata minulta? -N
      Ikävä
      51
      2859

    7. Oletko tyytyväinen viime tapaamiseemme?

      Vai toivoitko sen menevän toisella tavalla? Miten?
      Ikävä
      63
      2605

    8. Olet oikeasti ollut

      Niin tärkeä mulle ja kaikki meidän väliltä on pilattu ei yksistään sinun toiminnalla vaan minun myös.
      Ikävä
      22
      2468

    9. Kuuluu raksutus tänne asti kun mietit

      Pelkäätkö että särjen sydämesi vai mikä on? En mä niin tekisi mies koskaan 😘
      Ikävä
      29
      2412

    10. Nyt se sit loppuu

      Et ei enää nähdä ja yhteyttä pidetä.
      Ikävä
      41
      2294
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt