tiedot kommenttikenttään omille "sarakkeille"

kommenttikikkailija

Pystyykö jollain koodilla, vb:llä ym. siirtämään esimerkiksi Taul2 A1-10 - F1-10 eli 7 sarakkeen tiedot Taul1 A1 kommenttikenttään omiksi sarakkeiksi painonapilla tai enteriä painamalla? Kommenttikenttään tulisi voida siirtää tietoa vapaasti haluamassaan järjestyksessä vaikka vain rivi kerrallaan.

Taulujärjestys voi olla myös Taul1 =>Taul2.

4

107

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Tämmöinen

      Tarkoitatko mahdollisesti jotain tällaista:
      Sub kommentti()                                                                                    
      On Error Resume Next                                                                             
         Set alue = Worksheets("Sheet1").Range("A1:F10")                                        Set komm = Worksheets("Sheet2").Range("A1")                                        
         If Intersect(Selection, alue) Is Nothing Then                                                   komm.Comment.Delete                                                                          Else                                                                                                         nC = alue.Columns.Count                                                                          r1 = WorksheetFunction.Max(alue.Row, Selection.Row)                                  r2 = WorksheetFunction.Min(alue.Row   alue.Rows.Count - 1, _                                                 Selection.Row   Selection.Rows.Count - 1)                      l = 0                                                                                                     For Each s In alue                                                                                      l = WorksheetFunction.Max(l, Len(s)   2)                                                 Next s                                                                                           
            rivit = komm.Comment.Text                                                                      If Len(rivit) > 0 Then rivit = rivit & Chr(10)                                                  For R = r1 To r2                                                                                         For C = 1 To nC                                                                                         rivit = rivit & Left(alue(R, C) & Space(l), l)                                                Next C                                                                                                  If R < r2 Then rivit = rivit & Chr(10)                                                         Next R                                                                                           
            With komm                                                                                               .AddComment                                                                                         With .Comment                                                                                          .Visible = False                                                                                       .Text Text:=rivit                                                                                     With .Shape.TextFrame                                                                               .Characters.Font.Name = "Courier New"                                                       .Characters.Font.Size = 8                                                                         .AutoSize = True                                                                                 End With                                                                                            End With                                                                                           End With                                                                                            End If                                                                                                 End Sub

    • kommenttikikkailija

      Kiitos Tämmönen vb-koodista.
      Hieman repeillyt tuo koodi näyttää olevan, mutta varmaankin toimiva.
      Pitääkö tämä tulla johonkin tiettyyn paikkaan eli moduuliin, tiettyyn Tauluun vaiko Tähän työkirjaan ja onko tuo sellainen, että se on jatkuvasti aktiivinen -huono ilmaisu- vai pitääkö se "käynnistää" jotenkin että tekee jotain?

    • Tämmöinen

      Tulee moduliin ja sitä pitää kutsua erikseen. Sen voi linkittää vaikka nappiin. Makro liittää muuttujassa komm määrätyn solun kommenttiin tiedot alueen A1:F10 niiltä riveiltä, jotka ovat maalattuna. Kommentti poistetaan, jos aktiivinen solu on tuon alueen ulkopuolella. Makro ei tarkista rivien järjestystä tai sitä tuleeko sama rivi useaan kertaan. Alla sama makro ilman yritystä muotoilla sitä luettavammaksi.

      Sub kommentti()
      On Error Resume Next
      Set alue = Worksheets("Sheet1").Range("A1:F10")
      Set komm = Worksheets("Sheet2").Range("A1")
      If Intersect(Selection, alue) Is Nothing Then
      komm.Comment.Delete
      Else
      nC = alue.Columns.Count
      r1 = WorksheetFunction.Max(alue.Row, Selection.Row)
      r2 = WorksheetFunction.Min(alue.Row alue.Rows.Count - 1, Selection.Row Selection.Rows.Count - 1)
      l = 0
      For Each s In alue
      l = WorksheetFunction.Max(l, Len(s) 2)
      Next s

      rivit = komm.Comment.Text

      If Len(rivit) > 0 Then rivit = rivit & Chr(10)
      For R = r1 To r2
      For C = 1 To nC
      rivit = rivit & Left(alue(R, C) & Space(l), l)
      Next C
      If R < r2 Then rivit = rivit & Chr(10)
      Next R

      With komm
      .AddComment
      With .Comment
      .Visible = False
      .Text Text:=rivit
      With .Shape.TextFrame
      .Characters.Font.Name = "Courier New"
      .Characters.Font.Size = 8
      .AutoSize = True
      End With
      End With
      End With
      End If
      End Sub

    • kommenttikikkailija

      Kiitos Tämmönen, sain tämän toimimaan varmaan niin kuin sen pitääkin toimia.
      Hieman pitikin tosiaan testailla miten tämä lopulta toimi.
      Paljon olisi kysymyksiä, mutta koitan ensin viilailla tätä jos se taipuisi kokeiluihini. :)

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

    Luetuimmat keskustelut

    1. Putin ei suostu tulitaukoon nyt kun Kurskin taistelut ovat kesken

      ja venäjä on viimein päässyt niskan päälle, suuren ylivoiman turvin. Ukraina ilmeisesti suorittaakin taktista vetäytymi
      Maailman menoa
      199
      1855
    2. Martinan firma haastettiin käräjille

      Seiska: Martinan firma haastettiin käräjille, taustalla outo rahasotku.
      Kotimaiset julkkisjuorut
      266
      1824
    3. Toivotko vielä et

      Päätyisimme yhteen?
      Ikävä
      84
      1152
    4. Miksi haluat satuttaa

      Sillä tiedolla ettet välittäisi minusta vaikka se ei ole totta. Silti tiedän että rakastat minua edelleen. Niinkuin sano
      Ikävä
      28
      1141
    5. Miksi ette halua kaivattuanne

      Yksi syy tai tekosyy.
      Ikävä
      74
      1080
    6. Ketä sinä

      Odotat oikeasti. Miksen sulle totta olla saa.
      Ikävä
      117
      1030
    7. Oletko kaivattusi

      Mielestä hyvä sängyssä🤔
      Ikävä
      86
      1021
    8. Martina makkarankuori päällä

      Voi hyvää päivää minkä asun oli valinnut Emma gaalaan, ei jäänyt kenellekään epäselväksi, minkälaiset rinnat on naikkose
      Kotimaiset julkkisjuorut
      158
      986
    9. Millainen ihminen linda brandt-ahde on

      Hän on nyt julkisuudessa varsin eriskummallisen asian tiimoilta
      Lappeenranta
      39
      973
    10. Tykkäätkö kuinka

      Paljon kaivatustasi?
      Ikävä
      59
      897
    Aihe

    Tarvitsemme suostumuksesi tarjotaksemme personoitua palvelua

    Palvelu ja sen kolmannen osapuolen toimittajat (72) keräävät henkilötietoja (esim. IP-osoite tai laitetunniste) käyttäen evästeitä ja muita teknisiä keinoja tietojen tallentamiseen ja lukemiseen laitteellasi tarjotakseen sinulle tarkoituksenmukaisia mainoksia ja parhaan mahdollisen asiakaskokemuksen.

    Palvelu ja sen kumppanit tarvitsevat suostumuksesi seuraaviin:

    Tarkoitukset

    Tarkkoja sijaintitietoja ja laiteominaisuuksia koskevia tietoja voidaan käyttää.

    Mainonta voidaan yksilöidä profiilin perusteella. Toimintaasi tässä palvelussa voidaan käyttää sinua koskevan profiilin luomiseen tai parantamiseen yksilöityä mainontaa varten. Mainonnan suorituskykyä voidaan mitata.

    Sisältö voidaan yksilöidä profiilisi perusteella. Toimintaasi tässä palvelussa voidaan käyttää sinua koskevan profiilin luomiseen tai parantamiseen yksilöityä sisältöä varten. Sisällön tehokkuutta voidaan mitata. Raportit voidaan luoda oman ja muiden toiminnan perusteella. Toimintasi tässä palvelussa voi auttaa kehittämään ja parantamaan tuotteita ja palveluita.

    Evästeet, laitteet tai vastaavat verkkotunnisteet (esimerkiksi kirjautumisperusteiset tunnisteet, satunnaisesti määritetyt tunnisteet, verkkopohjaiset tunnisteet) sekä muut tiedot (esimerkiksi selaimen tyyppi ja tiedot, kieli, näytön koko, tuetut tekniikat jne.) voidaan tallentaa laitteellesi tai lukea laitteellasi laitteen tunnistamiseksi joka kerta, kun se muodostaa yhteyden sovellukseen tai verkkosivustoon yhdessä tai useammassa tässä esitetyssä tarkoituksessa.

    Erityisominaisuudet

    Hyväksynnälläsi tarkkaa sijaintiasi (alle 500 metrin säteellä) voidaan käyttää tässä ilmoituksessa kuvattujen tarkoitusten tueksi.

    Hyväksynnälläsi tiettyjä laitettasi koskevia ominaisuuksia saatetaan pyytää ja käyttää erottamaan se muista laitteista (kuten asennetut fontit tai laajennukset, näyttösi resoluutio) tässä ilmoituksessa kuvattujen tarkoitusten tueksi.

    Hyväksymällä sallit tietojesi käsittelyn. Suostumuksesi koskee tätä palvelua, hyväksymättä jättäminen voi vaikuttaa asiakaskokemukseesi. Jotkut teknologiat saattavat perustella tietojen käsittelyä oikeutetulla edulla, voit vastustaa tätä tai muuttaa muita asetuksia klikkaamalla Asetukset linkkiä.

    Tietosuoja