Makrolla solut osiin ja taulukoksi

Anonyymi-ap

Pitäisi saada tälläinen makro, enkä itse osaa

Makro jakaa solun osiin ja laittaa tiedot allekkain

Solun sisällä oleva erotinmerkki vaihtelee tilanteittain ja solualueen koko ja sijainti vaihtelee
Yhden kokonaisuuden / tilanteen sisällä kaikki erotinmerkit ovat samat
Yhden solun sisältö ( vaikka B2) on esim.
tammi;helmi;maalis ja määrä vaihtelee
Toisen solun sisältö (vaikka B3) on esim.
maanantai;tiistai;keskiviikko ja määrä vaihtelee
Ja rivimäärä vaihtelee

Makron vastaus olisi:
tammi
helmi
maalis
Välissä yksi tyhjä solu
maanantai
tiistai
keskiviikko

Kun käyttäjä käynnistää makron, hän valitsee inputboxin avulla:
erotin merkin
ja
käsiteltävän sarakkeen, josta makro osaisi ottaa kaikki täytetyt solut käsittelyyn mukaan
ja
Solun, josta alkaen vastaukset tulevat

Löysin netistä makroja, jotka toimivat osittain kuvatun mukaan
Yksi makro tekee juuri noin kuten kuvasin, mutta käyttäjä ei voi tehdä mitään valintoja.
Toisessa makrossa käyttäjä voi valita erotinmerkin inboxilla, mutta makro jakaa vain yhden solun osiin eikä muita valintoja voi tehdä

Tällä palstalla on ollut Excelin vba-koodauksen superosaajia.
Voisitteko tehdä tuollaisen makron?

Kovasti kiitoksia jo etukäteen

1

760

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Anonyymi

      Tarvittavat lähtötidot valitaan tässä InputBoxien sijaan UserFormilla. Tarvitaan kolme TextBoxia ja CommandButtonia (ja oman mielen mukaan muuta):
      TextBox1 - erotin
      TextBox2 - alue, jolta tiedot luetaan. Alueen voi valita CommandButton1:llä
      TextBox3 - solu, josta lähtien tulostetaan. Alueen voi valita CommandButton2:lla
      CommandButton1 - tulostaa rivit alkaen
      CommandButton2 - päivittää luettavaksi alueeksi valittuna olevan alueen
      CommandButton3 - päivittää tulostuksen alkamaan valittuna olevasta solusta

      UserForm1 aukeaa makrolla riveiksi ja jää näkyviin kunnes se suljetaan. Oletuksena tulostettavaksi valitaan rivit, jotka ovat valittuna kun makro käynnistetään ja tulostus tulee siitä yhden rivin päähän.

      Formin moduliin:

      Private Sub CommandButton1_Click()
          tee
      End Sub

      Private Sub CommandButton2_Click()
          UserForm1.TextBox2.Text = osoite(Selection)
      End Sub

      Private Sub CommandButton3_Click()
          UserForm1.TextBox3.Text = tulostusosoite(Selection)
      End Sub

      Private Sub UserForm_Activate()
          UserForm1.TextBox2.Text = osoite(Selection)
          tulostus = osoite(Cells(Selection.Row   Selection.Rows.Count   1, Selection.Column))
          Debug.Print tulostus
          UserForm1.TextBox3.Text = tulostus
      End Sub

      Tavalliseen moduliin:

      Sub riveiksi()
          UserForm1.TextBox2.Text = osoite(Selection)
          UserForm1.TextBox3.Text = tulostusosoite(Cells(Selection.Row   Selection.Rows.Count   1, Selection.Column))
          UserForm1.Show False
      End Sub

      Function osoite(r As Range) As String
          osoite = WorksheetFunction.Substitute(r.Address, "$", "")
      End Function

      Function tulostusosoite(r As Range) As String
          o = osoite(Selection)
          l = InStr(o, ":") - 1
          If l < 0 Then l = Len(o)
          tulostusosoite = Left(o, l)
      End Function

      Sub tee()
          erotin = UserForm1.TextBox1.Text
          Set alue = Range(UserForm1.TextBox2.Text)
          Set tulos = Range(UserForm1.TextBox3.Text)
          r = tulos.Row
          c = tulos.Column
          For Each s In alue
              t = Split(s, erotin)
              For i = 0 To UBound(t)
                  Cells(r, c) = t(i)
                  r = r   1
              Next i
              r = r   1
          Next s
      End Sub

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

    Luetuimmat keskustelut

    1. Ikävöin sinua kokoyön!

      En halua odottaa, että voisin näyttää sinulle kuinka paljon rakastan sinua. Toivon, että uskot, että olen varsin hullun
      Ikävä
      44
      3126
    2. Kova karman laki

      Karman lain kautta pahantekijä tehdessään pahaa toteuttaa koston ja rangaistuksen sille jolle pahaa on tehty. Tämä tarko
      Hindulaisuus
      508
      1917
    3. Päivieni piristys, missä olet?

      Toit iloa ja valoa mun elämään ☀️ Nyt mennyt kohta viikko ettei ole nähty. Kaipaan nähdä sua silti ja pelkään vaikka tei
      Ikävä
      17
      1900
    4. Näen jatkuvasti Sompasaunalla alastomia miehiä ja naisia

      jotka menevät siihen viereiseen rantaan myös uimaan alasti. Sompasaunat on siis Mustikkamaalla Helsingissä, ja kuljen si
      Maailman menoa
      78
      1680
    5. Älä mahdollisesti ota itseesi

      En voinut tietää. Sitäpaitsi.. niin
      Ikävä
      18
      1502
    6. Jos sinä olisit pyrkimässä elämääni takaisin

      Arvelisin sen johtuvan siitä, että olisit taas polttanut jonkun sillan takanasi. Ei taida löytyä enää kyliltä naista, jo
      Tunteet
      43
      1388
    7. Ota nainen yhteyttä ja tee Tikusta asiaa?

      Niin sitten minä teen Takusta asiaa.
      Ikävä
      26
      1322
    8. Millainen kaivattusi luonne on?

      Millaisia luonteenpiirteitä arvostat kaivatussa? Oletteko samanlaisia luonteeltanne?
      Ikävä
      90
      1319
    9. Helena ja Mikko Koivun ero jatkuu edelleen ja loppua ei näy.

      Voi eikä, miksi menee noin vaikeaksi avioero ja sopua ei tää ex- pari vaan saa.
      Kotimaiset julkkisjuorut
      114
      1147
    10. UPM suunnittelee paperintuotannon lopettamista LPR:ssa

      Ilta-Sanomissa oli uutinen. Metsäyhtiö UPM suunnittelee paperintuotannon lopettamista Kaukaan-tehtaalla Lappeenrannassa
      Lappeenranta
      110
      1123
    Aihe