Puoliautomaattista solujen täyttämistä

Seuraava tulee Taul2:n moduliin:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Row = 2 And Target.Column = 1 Then
      For i = 1 To 200
         If Worksheets("Taul1").Cells(i, 1) = "" Then
            Worksheets("Taul1").Cells(i, 1) = Target.Value
            Exit Sub
         End If
      Next i
      MsgBox ("Sarake A on jo täynnä!")
   End If
End Sub

Sain "Tämmöinen":n laittaman koodin toimimaan haluamallani tavalla tyhjässä taulukossa, kunhan Taul1:ssä ei ollut ennestään mitään koodia ja muuttamalla tuon
"For i = 1 To 200" ====> For i = 2 To 200:ksi, niin sain täyttämisen alkamaan Taul1 A2:sta.
Myös toivomani ominaisuus: jos välistä tyhjennetään rivejä, koodi huomaa sen ja alkaa täyttää ylimmästä tyhjästä kaikki tyhjät ensin. Tämä oli se yksi oleellinen toive.

Kunden koodi toimi myös, mutta se ei huomioinut, jos matkan varrella tuli ylemmäs tyhjiä rivejä ja olisi täyttänyt ne ensin.

Eikä tässä vielä kaikki.
Kunde on joskus tehnyt alla olevan koodin, jota olen hyödyntänyt ja käyttänyt päivittäin.
Tämä alla oleva koodi on Taul1:ssä eikä ylempänä olevat koodit toimi samaan aikaan.

Onko mahdoton yhtälö saada alkuperäinen yllä oleva toiveeni toimimaan tämän alla olevan Kunden koodin kanssa?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Target, Range("A2:A200")) Is Nothing Then
If Not Target = "" Then
Range("G" & Target.Row) = Now()
ThisWorkbook.Save
End If
End If
If Not Intersect(Target, Range("B2:I200")) Is Nothing Then
If Not Intersect(Target, Range("I2:I200")) Is Nothing Then
If Not Target = "" And Not Range("A" & Target.Row) = "" Then
Range("H" & Target.Row) = Now()
Range("J" & Target.Row) = "PÄIVITÄ"
Else
' hipsaa seuraava rivi, jos et halua, että I- sarakkeen solu tyhjenee hutitilanteessa
Target = ""
End If
End If
End If
If Not Intersect(Target, Range("J2:J200")) Is Nothing Then
If Target = "PÄIVITÄ" Then
Worksheets("Taul3").Range("Rivi" & Target.Row - 1).Resize(4).Copy Worksheets("Taul3").Range("Rivi" & Target.Row - 1).Offset(1)
Range("A" & Target.Row & ":I" & Target.Row).Copy Worksheets("Taul3").Range("Rivi" & Target.Row - 1).Resize(1)
Target = ""
Range("I" & Target.Row) = ""
Range("H" & Target.Row) = ""
Range("A" & Target.Row) = ""
Range("G" & Target.Row) = ""
Range("B" & Target.Row) = ""
Range("C" & Target.Row) = ""
Range("D" & Target.Row) = ""
Range("E" & Target.Row) = ""
Range("F" & Target.Row) = ""
Range("A" & Target.Row).Comment.Delete
End If
End If
Application.EnableEvents = True
End Sub

Tuli mieleen, että pystyykö Lisäkommenttia (se punainen kolmio) tekemään ja täyttämään jollain makrolla, VB-koodilla tai kaavalla halutun solun tiedot haluttuun soluun Lisätietokenttään?

Mulla toimii kuvio, jossa saan Taul2 B3:n vaihtuvat tiedot siirtymään Taul1 A-sarakkeen aina ensimmäiseen vapaaseen soluun välillä 2-200.

Lisätoive oli se, että saisin samanaikaisesti siirtymään myös C3:n vaihtuvat tiedot Taul1 A-sarakkeen saman vapaan solun Lisäkommenttikenttään. Nyt joudun kopioimaan Taul2 C3:n tiedot käsin Lisätietokenttään.

>>arvatenkin haluat sieltä Taul2 jostain solusta lisätä johonkin Taul1 soluun hakemasia tietoja. Entä jos on jo tietoa solun kommentissa - poistetaanko vaiko lisätään perään?<<

Hyvä pointti Kunde. Taul1:n solurivit on lähtökohtaisesti aina tyhjiä, joten mitään tietoa ei ole.. ei edes edellistä Lisäkommenttikenttää ole, vaan se pitäisi luoda samalla kertaa.

Hieman samanlaista tarvetta kuin nimim. #tuotenikkari# olisi itselläni.
Saan sähköpostilla exceleitä, joista kerään kopioimalla-liittämällä tiettyjen solujen tiedot erilliseen koonti-exceliin, josta ne päätyy jossain vaiheessa ns. työkalutiedostoon kaikkien käyttöön. Teen siis itsekin eräänlaista tuotelistaa kommenttikenttineen.
Olisi kyllä suuri apu, jos saisi nappia painamalla ohjattua osan tiedoista A-sarakkeen seuraavan tyhjän solun lisätietokenttään tuolla samalla filosofialla.

Miten tieto siirtyisi A-sarakkeiden välillä vaikkapa Taul2:sta Taul1:een?

Kiitos Kunde hyvin toimivasta alla olevasta Taul1 -koodista.
Muutama lisäkysymys ja huomio..
Jos normaalisti tekee "Lisää kommentti"-kentän, tulee keltaisen kommenttikentän yläreunaan käyttäjän, eli minun nimeni Boldattuna.
Tässä sinun koodirivissäsi: "Target.Comment.Text Worksheets("Taul2").Range("C2").Text" -jää Boldattu nimen yläreunasta pois.

Lisäkysymys 1: Onnistuuko koodiisi lisäämään ominaisuuden, että käyttäjän nimi (Sukunimi Etunimi) tulisi kommenttikentän yläreunaan?
Koitin itse lisätä sitä koodisi väliin, mutta en onnistunut.

Kirjoitit: >>jälkimmäisen voi korvata toki Tämmöisen koodillakin( en testannut, mutta ilmeisesti toimii),
mutta siinä looppien määrä kasvaa rivimäärän kasvaessa, joten tehokkuus kärsii (ei tosin nyt merkittävästi vielä 200 rivillä) ;-)<<

-Hyödynsin tuota "Tämmösen" koodia omassani, koska siinä koodi täyttää järjestyksessä myös jälkikäteen tyhjennetyt tuoterivit.
Sinun versiossa koodi ei hyödynnä väliin jääviä tyhjiä rivejä, vaan jatkaa vain järjestyksessä alaspäin. Käsitinkö tämän oikein?

Lisäkysymys 2: Mitä tarkoittaa käytännössä tuo "looppien määrä kasvaa rivimäärän kasvaessa"? Pystyykö sen kumoamaan tuossa "Tämmösen" koodissa?


Taul1 moduuliin ja varmista , ettei ole jo samannimistä proseduuriaennestään
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Target, Range("A2:A200")) Is Nothing Then
If Not Target = "" Then
Range("G" & Target.Row) = Now()
'muuta soluosoitetta tarvittaessa
'jos muualle kuin A sarakkeeseen käytä target.Offset (0,XXX) solun osoitteena. Muista että offset on 0-pohjainen
If Target.Comment Is Nothing Then Target.AddComment
Target.Comment.Text Worksheets("Taul2").Range("C2").Text
ThisWorkbook.Save
End If
End If
If Not Intersect(Target, Range("B2:I200")) Is Nothing Then
If Not Intersect(Target, Range("I2:I200")) Is Nothing Then
If Not Target = "" And Not Range("A" & Target.Row) = "" Then
Range("H" & Target.Row) = Now()
Range("J" & Target.Row) = "PÄIVITÄ"
Else
' hipsaa seuraava rivi, jos et halua, että I- sarakkeen solu tyhjenee hutitilanteessa
Target = ""
End If
End If
End If
If Not Intersect(Target, Range("J2:J200")) Is Nothing Then
If Target = "PÄIVITÄ" Then
Worksheets("Taul3").Range("Rivi" & Target.Row - 1).Resize(4).Copy Worksheets("Taul3").Range("Rivi" & Target.Row - 1).Offset(1)
Range("A" & Target.Row & ":I" & Target.Row).Copy Worksheets("Taul3").Range("Rivi" & Target.Row - 1).Resize(1)
Target = ""
Range("I" & Target.Row) = ""
Range("H" & Target.Row) = ""
Range("A" & Target.Row) = ""
Range("G" & Target.Row) = ""
Range("B" & Target.Row) = ""
Range("C" & Target.Row) = ""
Range("D" & Target.Row) = ""
Range("E" & Target.Row) = ""
Range("F" & Target.Row) = ""
Range("A" & Target.Row).Comment.Delete
End If
End If
Application.EnableEvents = True
End Sub
Sub Resetoi()
Application.EnableEvents = True
End Sub

muuta Taul1 koodissa ...

nyt käyttäjän nimi boldattuna ja punaisella
hipsaa With... - End With jos et tartte ominaisuuksia...
Käyttäjän nimen voit vaihtaa Tiedosto/Asetukset/Yleiset ja siellä kirjoitat Käyttäjänimeen haluamaasi nimen tai sitten lisäät koodissa poistamalla hipsun

If Target.Comment Is Nothing Then Target.AddComment
'Application.UserName = "Kunde"
Target.Comment.Text Application.UserName & ":" & vbNewLine & Worksheets("Taul2").Range("C2").Text

With Target.Comment.Shape.TextFrame
Dim Pituus As Long
Pituus = Len(Application.UserName) 1
.Characters(1, Pituus).Font.ColorIndex = 3
.Characters(1, Pituus).Font.Bold = True
End With
ThisWorkbook.Save
End If

"Sinun versiossa koodi ei hyödynnä väliin jääviä tyhjiä rivejä, vaan jatkaa vain järjestyksessä alaspäin. Käsitinkö tämän oikein?"

ET, kyllä se täyttää ihan järjestyksessä ylhäältä alaspäin ekaan tyhjään soluun. Hieman ekstratarkistuksia jouduin tekemään, jos sattuisi olemaan täysin tyhjä A- sarake, kun aloittaa ja en tiennyt onko esim. A1 solussa tekstiä vaiko ei.
Jos on niin sitten turhia tarkistuksi...


Mitä tarkoittaa käytännössä tuo "looppien määrä kasvaa rivimäärän kasvaessa"? Pystyykö sen kumoamaan tuossa "Tämmösen" koodissa?

For i = 1 To 200
If Worksheets("Taul1").Cells(i, 1) = "" Then
Worksheets("Taul1").Cells(i, 1) = Target.Value
Exit Sub
End If
Next i

eli jos eka tyhjä olisikin vasta A200, niin ollaan luupattu 199 kertaa... ja jos isompi rivimäärä eka tyhjä olisi vaikka A100000 niin olisi luupattu 99999 kertaa ennenkuin tyhjä solu on löydetty

oma koodini ei luuppaa ;-)
ja ei voi kumota tolla rakenteella luuppien määrää (for- next)

Keep EXCELing
@Kunde

No nyt on sitten tuo Lisäkommenttikenttäkuviokin kunnossa. Kiitos Kunde kovasti, tällaista olin mielessäni pyöritellytkin!
Otin kyllä nuo ominaisuudet käyttöön täysimääräisenä, eli niille oli myös käyttöä.

Arvelinkin, että tein jotain väärin, kun sinun vastaavaa Taul2 -versiota kokeilin.. eli sen pitääkin toimia juuri siten kun alun perin toivoin.
Menen tällä nykyisellä "Tämmösen" koodilla ja katson miten pitkään tällä pärjää.
Jos nuo luupit rupeaa tökkimään, niin vaihdan sinun versioon.

kyllä ne siellä on, kunhan osaa etsiä oikeasta paikasta... ;-)

luultavasti toi Autoshape=true riittää sulle?
Jos ei niin hipsaa se rivi ja poista hipsut seuraavilta 3 riviltä ja muuta mitat sopiviksi, mutta luulen, että toi eka on parempi vaihtoehto.

Huomaa pikku muutos With -End With rakenteessa
ennen oli With Target.Comment.Shape.TextFrame
nyt With Target.Comment.Shape


If Target.Comment Is Nothing Then Target.AddComment
'Application.UserName = "Kunde"
Target.Comment.Text Application.UserName & ":" & vbNewLine & Worksheets("Taul2").Range("C2").Text
With Target.Comment.Shape
Dim Pituus As Long
Pituus = Len(Application.UserName) 1
.TextFrame.Characters(1, Pituus).Font.ColorIndex = 3
.TextFrame.Characters(1, Pituus).Font.Bold = True
.TextFrame.AutoSize = True
'.TextFrame.AutoSize = false
'.Width = 100
'.Height = 300
End With
ThisWorkbook.Save
End If

Keep EXCELing
@Kunde

Aika huikeeta Kunde, kiitos paljon! Nämä molemmat koodit tulikin tarkkaan hyödynnettyä. Aika kului mukavasti tuon .AutoShapeType = msoShapeBalloon:n äärellä.. joukossa jopa ihan tyylikkäitäkin kenttiä, kuten tuo alimmainen wanhan pergamentin näköinen. :) Tämä osio ansaitsee erillisen kiitoksen, sen verran hieno niksi.

Nyt kun otit puheeksi.. minkälaista lisäkoodia tarvittaisiin kuvan liittämiseksi? Rupesi kiinnostamaan. ;D

Nyt on kiinnostava keissi. Tartun lähinnä tuohon Lisää kommentti kenttään.
Pidän excelillä yllä eräänlaista tuurauskalenteria sekä tapahtumalokia käsipelillä, kun en osaa itse suunnitella koodeja ja automatisointeja.
Haluaisin että:
Taul2:ssa olisi A sarakkeessa henkilöt, B sarakkeessa alaspudotusvalikossa tuurauskohde (näyttämö, tarpeisto, rekki..ym..) C sarakkeeseen tulisi viikkomerkinnät käsin esim. vkt.1-7

Itselleni sopisi mitä mainioimmin se, että Taul2 lehdellä tekemäni tuuraustiedot henkilöiden n. 15 kpl kohdalla listautuisivat Taul1 sivulle ko. henkilön lisäkommenttikenttään periaatteella lisääntyvä loki.
Nyt merkitsen ne käsipelillä manuaalisesti kommenttikenttään siten, että uusin tuuraus tulee aina ylimmäiseksi ja vanhin on listan alimmaisena.
Loki saisi kommenttikentässä olla ainakin 10-20 rivinen.

Onnistuuko Taul2:lla tehdyt tuurausviikotiedot siirtää automaattisesti ko. henkilön kohdalta automaattisesti Taul1:een ko. henkilön kommenttikenttään?
Olisi helppo yhdellä silmäyksellä nähdä jokaisen tuurausviikot Taul1:n varsinaisella kalenterisivulla.
Tuurausviikot merkitään tyylillä:
Henkilö A - Näyttämö2 vkt.6-10
- Näyttämö1 vkt.1-5

Henkilö B - Tarpeisto1 vkt.8-12
- Tarpeisto2 vkt.1-7

Henkilö C - Rekki1 vkt. 12-15

Henkilö D - Rekki2 vkt. 16-20

Henkilö E - Valoapu1. 22-33

jne..

Myös Taul1:ssä on A-sarakkeessa henkilöiden nimet ja jokaisella on kommenttikenttä, josta näkee tapahtumat.

Tämä pieni automatisointi helpottaisi muita töitä. :)

Jos ei aukee, niin tarkennan lisää.

tuotenikkari>>>
haluatko kuvat tiedostosta vaiko työkirjalta?

Tematiikkavastaava>>>

tavalliseen moduuliin...

Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Boolean

Dim solu As Range

Dim EkaOsoite As String
Worksheets("Taul1").Activate
EtsiJaSiirrä = False
With HakuAlue

Set solu = .Find(What:=Hakuehto, LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not solu Is Nothing Then
If solu.Comment Is Nothing Then
solu.AddComment
solu.Comment.Text Hakuehto & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1")
Else

x = Len(solu.Comment.Text) - Len(Application.WorksheetFunction.Substitute(solu.Comment.Text, vbCrLf, ""))
'tähän 1 enemmän kuin haluat riviä näytettävän
If x < 5 Then
Else
solu.Comment.Text Worksheets("Taul2").Range("A1") & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1") & vbNewLine & Mid(solu.Comment.Text, InStr(1, Range("A2").Comment.Text, vbCrLf) 2)
End If

End If
EtsiJaSiirrä = True
End If

End With
Worksheets("Taul2").Activate
End Function

ja liitä koodi vaikka ActiveX nappiin TAUL2:ssa


KEEP NEW YEARING
@Kunde

P.S. Ilmottautukaa kurssille http://keskustelu.suomi24.fi/t/13999713/vba-kurssi
ei mitään makronauhoituksia ja p****n jauhantaa 2 pv vaan tosi ACTIONIA n 40 tuntia!!

Moikka Kunde,
Tein koeluonteisen taulukon viidelle henkilölle (henkilöt A, B, C, D, E). Taul1:een tuli jokaiselle oma kommenttikenttä ja Taul2:een omat rivit henkilöille tietoineen.
Koodi toimi, mutta hieman rajallisesti, nappia painamalla ainoastaan henkilölle A tuli tapahtumia lokiin (Taul1 kommenttikenttään).
Tähän asti kaikki ok, mutta jokaisella uudella napin painamisella henkilölle A tuli kommenttikenttään uusi rivi, mutta samoilla tiedoilla. Oli ajatuksena, että kommenttikenttään tulisi uusi rivi vasta kuin Taul2:ssa tietokin vaihtuisi ja että uusin tieto tulisi aina ylimmäiseksi ja vanhin jäisi alimmaiseksi.

Tässä huomioni lyhyesti. :)

Onko mitään enää tehtävissä? :D

Tosiaan nuo kelpoisuusehdot, sen unohdin.
Tein uuden koeluonteisen taulukon. Taul2:een A-sarakkeeseen nimet ja B-sarakkeeseen alaspudotsuvalikko, jossa nuo paikat (noudetaan Taul3:sta). C-sarakkeessa aika.
Tuolla koodilla sama lopputulos, eli Taul1:ssä vain ekalle henkilölle A1:een tuli tapahtumat. Nappia painamalla se kopioitui, kun tieto ei vaihtunut.

Odotan mielenkiinnolla päivitystä koodille.

Btw.. >>ei kovin helppoa muuten hallita.<<
Tarkoititko, että koodin tekeminen on vaikeaa, vai että teen itse tuosta vaikean? :D

Kiitos taas koodista Kunde!
Joku kummajainen on, kun en saa tuota koodia toimimaan.

Tuo ensimmäinen rivi:
>>Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Boolean<<
-menee keltaiseksi,

tässä:
>>y = EtsiVika(Chr(13), solu.Comment.Text, x - 1)>>
-"Etsi vika" sinistyy kuin hiirellä maalattuna.

nämä on punaisella:
>>Function EtsiVika(MitäEtsitään As String, _
MistäEtsitään As String, MoneskoEsiintymä As Long) As Long<<

Teenhän oikein tuon modulin..? Tuplaklikkaan VB:ssä Taul2 ja saan Modul1 -ikkunan, jonne laitan koodin ja napin makron, molemmat omissa osioissaan.

Menee mielenkiintoiseksi. Esitin asiani huonosti, tarkoitin, että tuplaklikkaanko VBAProjekti-ikkunassa olevaa Taul2(Taul2) -kohtaa.. en siis tarkoittanut Excelin Taul2:a. :)

Mutta asiaan.. en saa toimimaan. Olen toiminut seuraavasti:
Excelin Taul1:iin luotu A-sarakkeeseen henkilöt A:sta E:n ja kaikilla kommenttikentät.
Excelin Taul2:ssa A-sarakkeessa samat henkilöt, B-sarakkeessa paikat (alaspudotusvalikko, hakee Taul3:sta), C-sarakkeessa ajat.

Tuon uusimman koodisi pudotin juuri tuonne Modules/Module1 .
Sitten tulee kohta, josta pitää kysyä tarkennus. Tuleeko napin koodi Module1:een vai Module2:een? Kummallakaan en kylläkään saa tätä toimimaan.

Teen takuulla jotain nyt väärin, mutta mitä. :((

Ei tartte edes kommentteja tehdä...

Taul 2 moduuliin sille napille koodi...

Private Sub CommandButton1_Click()
EtsiJaSiirrä Worksheets("Taul2").Range("A1"), Worksheets("Taul1").Range("A:A")
End Sub


tavalliseen moduuliin...
Module 1 koodit...

Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Boolean

Dim solu As Range
Dim x As Long
Dim y As Long
Worksheets("Taul1").Activate
EtsiJaSiirrä = False
With HakuAlue

Set solu = .Find(What:=Hakuehto, LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not solu Is Nothing Then
If solu.Comment Is Nothing Then
solu.AddComment
solu.Comment.Text Hakuehto & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1")
Else

x = Len(solu.Comment.Text) - Len(Application.WorksheetFunction.Substitute(solu.Comment.Text, Chr(13), "")) 1
If x < 4 Then
solu.Comment.Text Worksheets("Taul2").Range("A1") & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1") & vbNewLine & Mid(solu.Comment.Text, InStr(1, solu.Comment.Text, Chr(13)) 2)
solu.Comment.Shape.TextFrame.AutoSize = True
Else

solu.Comment.Text Worksheets("Taul2").Range("A1") & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1") & vbNewLine & Mid(solu.Comment.Text, InStr(1, solu.Comment.Text, Chr(13)) 2)
y = EtsiVika(Chr(13), solu.Comment.Text, x - 1)
solu.Comment.Text Mid(solu.Comment.Text, 1, y)
solu.Comment.Shape.TextFrame.AutoSize = True
End If

End If
EtsiJaSiirrä = True
End If

End With
Worksheets("Taul2").Activate
End Function

Function EtsiVika(MitäEtsitään As String, _
MistäEtsitään As String, MoneskoEsiintymä As Long) As Long
Dim i As Integer
Application.Volatile
EtsiVika = 0
For i = 1 To MoneskoEsiintymä
EtsiVika = InStr(EtsiVika 1, MistäEtsitään, MitäEtsitään)
If EtsiVika = 0 Then Exit For
Next
End Function


Keep EXCELing
@Kunde

Moikka,
Näyttäisi koodi toimivan toivomallani tavalla, mutta vain ensimmäisen "henkilön" kohdalla, eli rivillä 1. Yritin hieman katsoa, olisko koodissa kohtaa, jossa voisi listätä "henkilöitä" 2-rivi, 3- rivi, 4-rivi..jne, vai pitäisikö tuolla koodilla toimia useimmatkin rivi?
Onko mahdotonta saada saada esim. 15 henkilön rivit aikaiseksi kuten rivillä 1 jo toimii?

En jaksa nyt alkaa sääteleen 15 riville... ;- )
Kuten olen jo monta kertaa maininnut koodi toimii soluille A1, B1 ja C1 ja niihin tein kelpoisuusehdon, josta valitaan siirrettävä tieto ja se siirretään napilla.
En edelleenkään ymmärrä, miksi pitäisi saada 15 riviltä siirrettyä, kun se hoituu 1 rivilläkin ja helpommin?

Keep EXCELing
@Kunde

..nonythämmähokasin vasta.. tuohan onkin näppärä tapa hoitaa nuo kaikki Taul1:n henkilöt! Kun johonkin omaan kuvioon fakkiintuu, niin ei tahdo millään nähdä sitä toisen tapaa. ;-]] En siis oivaltanut, että tuolla Taul2:n yhdellä rivillä hoidetaan/hallitaan kaikkia Taul1:n rivejä.. tuleviakin.

Vielä kun saisi jostain määriteltyä noiden alaspudotusvalikoiden näkyvyyttä, eli mielellään soisi kaikkien 20:n kelpoisuusehtorivin näkyminen yhdellä kertaa, ettei tarvitsisi skrollailla. Se helpottaisi myös tätä hommaa. Mahtaakohan se olla edes mahdollista, kun ei mistään kelpoisuusehtoasetuksista ainakaan löydy.

Tästä koodista kiitos Kunde. :)

*glups*.. tänx Kunde.. nyt täytyykin skarpata tuon toiveen kanssa. :D -sain kyllä jo jotain aikaan, mutta tähän palaan vielä.
Mutta ennen kuin pureudun tuohon edelliseen, kysynkin.. miten saan "pilkottua" Taul2:ssa solun C1 tiedot esim. VK 1-10 kolmelle solulle, eli C1=VK, D1=1 ja E1=10?
Kokeilin itse lisätä koodia tälle riville(alla malli):
solu.Comment.Text Hakuehto & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1") & " " & Worksheets("Taul2").Range("D1") & " " & Worksheets("Taul2").Range("E1") & " " & Worksheets("Taul2").Range("F1")

-en saanut toimimaan.
Tämä olisi melkeinpä oleellisempi kuin tuo edellinen toive.

siis haluat Taul2 C1 tiedon soluihin C1:E1
mitä yritit koodissa menisi Taul1:ssä henkilön kommenttiin... ;-)

en tiedä mitä koodeja sulla käytössä, joten vaikea neuvoa
no vaikka näin...

Sub pilko()
Dim a
Dim b
a = Split(Range("C1"), " ")
b = Split(a(1), "-")
Range("C1")= a(0)
Range("D1")= b(0)
Range("E1")=b(1)
End Sub

Keep EXCELing
@Kunde

..kommenttiin ne saisikin mennä.. :)
Joo.. esitin taas pilkkomisasiani vajaavaisesti.
Eli, Alun perin laittamasi koodi siirsi tiedot Taul2:sta Taul1:een kommenttikenttiin. Tämä toimii hienosti.
Nyt kun Taul2 C1:ssä on (esim) tieto: VK 1-10 oli ajatuksenani että, tuo tieto olisi jaettu kolmelle solulle; C1=VK, D1=1 ja E1=10. Näin kaikki tieto soluista A1-E1 saisi siirtyä Taul1 kommenttikenttiin.

Kunde, ei sentään eri riveille -samalle riville riittää. :)
Se miksi halusin pilkkoa tuon C1:n tiedot kolmelle solulle johtuu käytännön syistä.
Solussa C1 oleva "VK" pysyy samana, mutta D1 ja E1 soluissa tieto vaihtuu. On helpompaa hiirellä vain aktivoida D1 tai E1 ja kirjoittaa viikkonumerot, kuin että editoi kursorin kanssa koko ajan C1 soluatietoa.
Tämä siis vain hieman helpottaisi tiedon muuttamista soluissa, kommenttikentässä se tieto silti näkyisi samalla tavalla.

Kiitos Kunde vaivannäöstäsi, en nyt mitenkään saa kyllä yhdistettyä vikaa postaustasi taulukkooni -jossa on siis sinun aiempi koodisi.
Tällä hetkellä olen tyytyväinen nykyiseenkin, eli Taul2:sta A1-C1 tieto siirtyy Taul1:een ja siellä ao. kommenttikenttiin.
Kuvittelin, että Taul2 C1, D1 ja E1:n tiedot saisi helposti yhdistettyä Taul1:n kommenttikenttiin vain kopioimalla koodisi:
solu.Comment.Text Hakuehto & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1")

-perään nämä:

& " " & Worksheets("Taul2").Range("D1") & " " & Worksheets("Taul2").Range("E1")

En halua _lisätä_ mitään siihen koodiin, vaan korvata tuon C1:ssä olevan esim.VK1-20.

Kokeilin tätä uudestaan, toimii kummallisesti.
solu.Comment.Text Hakuehto & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1")
& " " & Worksheets("Taul2").Range("D1") & "- " & Worksheets("Taul2").Range("E1")

Koodi toimi halutulla tavalla, mutta vain yhden kerran, eli kun ko. henkilön kohdalla ei ollut vielä mitään tietoa kommenttikentässä.
Päivittämällä henkilölle uudet tiedot Taul2 D1 ja E1:een, ei kommenttikenttään siirtynyt kuin C1 tieto, eli tuo "VK".
Kommenttikentän tyhjentäminen ko. henkilön kohdalla ei muuttanut enää tilannetta, edelleen vain C1 tieto siirtyi.

Visual BASICILLA...

..hetken kesti, ennen kuin ymmärsin kopsata tuon saman rimpsun seuraavalle "solu.Comment" -riville.
Vaan toimii ja hyvin toimiikin. Kiitos taas kovasti Kunde! :)

Miten helposti onnistuisi siirtää molemmissa Tauluissa kaikki alkamaan riviä alempaa, eli riviltä 2? Tämä taas helpottaisi tulevaa suunnitteluani.

No sehän olikin helppo juttu. Tnx!