Miten saan Taul2 A2:ssa vaihtuvan tiedon siirtymään automaattisesti Taul1 A2-A200:een aina ensimmäiseen ylimpään tyhjään soluun?
Taul1:ssä siis rivejä tyhjennetään ja täydennetään vaihtelevasti.
Tuon ulkoisesta lähteestä copy/pastettamalla tietoa ensin Taul2 A1-D6 solukenttään (liitän tiedon A1 -solussa), jolloin tärkein tuotenimi jää aina soluun A2:een, joka olisi oleellista saada siirtymään automaattisesti aina Taul1:n A-sarakkeen (2-200) ensimmäiseen tyhjänä olevaan soluun. Näin voisin "ladata" Taul1 A-sarakkeelle useita tuotteita peräkkäin ja mennä myöhemmin täydentämään loput tiedot uusille riveille.
Löytyisikö tähän minkäänlaista kaavaa kaavariville tai VB-koodikin kävisi. Osaan sen varmaankin siirtää sinne, kunhan tietää oikean moduulin.
Puoliautomaattista solujen täyttämistä
55
347
Vastaukset
- Tämmöinen
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 - tuotenikkari
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- tuotenikkari
Vastaan itselleni.
Sainkin tämän toimimaan niin, että poistin Taul1:stä väliaikaisesti Kunden tekemän koodin(yllä) ja lisäsin "Tämmöinen":n laittaman koodin (yllä ekana) koeluonteisesti Taul4:ään. Tämän jälkeen lisäsin Kunden koodin takaisin Taul1:een.
Mitenköhän tämä on mahdollista?!
- tuotenikkari
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?
Piece of cake
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?
Keep EXCELing
@Kunde- tuotenikkari
Jos tämä liittyi tähän:
>>Vastaan itselleni.
>>Sainkin tämän toimimaan niin, että poistin Taul1:stä väliaikaisesti Kunden >>tekemän koodin(yllä) ja lisäsin "Tämmöinen":n laittaman koodin (yllä ekana) >>koeluonteisesti Taul4:ään. Tämän jälkeen lisäsin Kunden koodin takaisin >>Taul1:een.
>>Mitenköhän tämä on mahdollista?!
-niin.. ei mielestäni ollut kahta saman nimistä. Vaan eikös nämä vb-koodit pidäkin välillä "asentaa" tyyliin; ennen sitä tai ennen tätä, ennen kuin suostuvat toimimaan. ;]
- tuotenikkari
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. - Tuotevastaava
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?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
************************************************************
siirtotaulukon moduuliin...
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A2")) Is Nothing Then
If Worksheets("Taul1").Range("A2").End(xlDown).Row >=2300 And Worksheets("Taul1").Range("A65536").End(xlUp).Row >= 200 Then
MsgBox "Ei tyhjiä soluja!!!"
Else
If Worksheets("Taul1").Range("A65536").End(xlUp).Row < 2 Then
Worksheets("Taul1").Range("A2") = Target
Else
If Worksheets("Taul1").Range("A65536").End(xlUp).Row < 3 Then
Worksheets("Taul1").Range("A1").End(xlDown).Offset(1).Value = Target.Value
Else
Worksheets("Taul1").Range("A2").End(xlDown).Offset(1, 0) = Target.Value
End If
End If
End If
End If
End Sub
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ä) ;-)oli jostai syystä rivimäärä lipsahtunut 2300, oikea siis 200
siirtotaulukon moduuliin...
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A2")) Is Nothing Then
If Worksheets("Taul1").Range("A2").End(xlDown).Row >=200 And Worksheets("Taul1").Range("A65536").End(xlUp).Row >= 200 Then
MsgBox "Ei tyhjiä soluja!!!"
Else
If Worksheets("Taul1").Range("A65536").End(xlUp).Row < 2 Then
Worksheets("Taul1").Range("A2") = Target
Else
If Worksheets("Taul1").Range("A65536").End(xlUp).Row < 3 Then
Worksheets("Taul1").Range("A1").End(xlDown).Offset(1).Value = Target.Value
Else
Worksheets("Taul1").Range("A2").End(xlDown).Offset(1, 0) = Target.Value
End If
End If
End If
End If
End Sub
Keep EXCELing
@Kunde- Tuotevastaava
Sain sitten itsekin näistä Kunden koodeista apua omiin hommiini. Kiitos siis mun puolelta myös Kundelle! Enempää en juuri nyt kaipaakkaan lisää tämän kanssa. :)
- tuotenikkari
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- tuotenikkari
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.- tuotenikkari
Pieni lisäkysymys liittyen tuon Kommenttikentän kokoon.
Pystyykö jostain asetuksista tai koodilla määrittelemään Kommenttikentän kokoa?
Eli kun hiiri viedään solun päälle näkyisi solussa oleva kommentti-ikkuna itse määrittelemässä koossa. Tuo automaattinen oletuskoko on usein liian pieni näyttämään yhdellä kertaa kaikki kentässä olevat tiedot.
Kätevintä olisi, jos sen voisi suoraan asetuksista määritellä.. en kyllä löytänyt.
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
@Kundejos haluat muuttaa kommentin muotoa...
lisää allaoleva rivi With-End With lausekkeen sisälle ( poista = msoShapeBalloon teksti ja kirjoita = -merkki , niin avautuu alasvetovalikko eri muodoille...)
.AutoShapeType = msoShapeBalloon
jos haluat kuvan niin sekin onnaa, mutta vaatii hiukan lisäkoodia ;-)
Keep EXCELing
@Kunde
- tuotenikkari
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 - Tematiikkavastaava
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!!Tematiikkavastaava>>>
unohtui mainita, että TAUL2:ssa
A1 henkilö
B1 paikka
C1 aika
ja koodi siirtää tiedot sitten Taul1
Keep EXCELing
@Kundejäi napinkin koodi pois näköjään...
eli tavalliseen moduuliin tämä...
Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Boolean
Dim solu As Range
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
solu.Comment.Text solu.Comment.Text & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1")
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 Taul2 nappiin tämä koodi...
Private Sub CommandButton1_Click()
EtsiJaSiirrä Worksheets("Taul2").Range("A1"), Worksheets("Taul1").Range("A:A")
End Sub
Keep EXCELing
@Kunde- Tematiikkavastaava
Tuo näyttää sopivan asialliselta tuo vb-koodi. :) Kiitos Kunde!
Onko tuo koodi ihan ns. käyttövalmis koodi, vai pitääkö jotain kohtaa muuttaa, jotta pääsee kokeilemaan?
Vaikka en ihan tumpelo olekaan tuossa vb-maailmassa, niin on silti pakko kysyä mitä tarkoittaa "tavalliseen moduuliin"? Makronapinkin osaan tehdä.. kaipaan silti pikku opastusta. Jelpitkö hieman Kunde, niin ei menis hukkaan koodisi.
Avasin harjoitusmielessä Excelin, jossa nyt Taul1 ja Taul2. Jos yhtään ymmärsin, niin koodisi tulisi Taul2:een, mutta tavalliseen moduuliin.. hmm eli ei siis tuplaklikkaamalla Taul2 VBAProjektissa vaan..?
Olisi kova tarve saada tämä toimimaan, jos pääsis alkuun tässä. Osaan kyllä soveltaa sitten omaan tarpeeseen, kunhan malli ensin toimisi. VBA editorin puolella valikosta INSERT/MODULE ja sinne proseduuri Function EtsiJaSiirrä(...)
ja napin koodi Taul2 moduuliin eli kuten kirjoititkin. Ja teet Taul2 ActiveX painikkeen ja jätät sen oletusnimelle eli CommandButton1.
Kun Klikkaat nappia se suorittaa sitten koodin
Private Sub CommandButton1_Click()
EtsiJaSiirrä Worksheets("Taul2").Range("A1"), Worksheets("Taul1").Range("A:A")
End Sub
ja toi suorittaa sitten EtsiJaSiirrä koodin tavallisessa moduulissa...
nyt siis Taul2
A1 = nimi
B1 =paikka
C1=aika
ja nappi joka suorittaa koodin
ja Taul1 A-sarakkeessa on nimisolut, joiden kommentteihin kirjoitetaan.
Muuta koodissa lokin rivien määrää muuttamalla x:n ehtoa
esim. 20 riviä
If x < 21 Then
Keep EXCELing
@Kunde
- Tematiikkavastaava
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ä? :DAjattelin, että soluissa A1 ja B1 on kelpoisuusehdot ja alasvetovalikosta valitaan tiedot soluihin A1 ja B1 ja C1 kirjoitetaan aika ja napilla lisätään, ei kovin helppoa muuten hallita.
Tsekkaan ehtoolla ton koodin. Uusin oli tarkoitus olla ylinnä ja lokia pitää halutun rivien verran muuttujan arvoa muuttamalla...
- Tematiikkavastaava
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"Odotan mielenkiinnolla päivitystä koodille.
Btw.. >>ei kovin helppoa muuten hallita.<<
Tarkoititko, että koodin tekeminen on vaikeaa, vai että teen itse tuosta vaikean? :D"
Jos solun arvot muuttuu ja se pitäsisi automatisoida niin helposti tulee virhelisäyksiä ja sitten niitä pitää mennä manuaalisesti poistelemaan...
Toisaalta voisi laittaa koodin kysymyksen "oletko varma, että haluat..." , mutta tyhmää ;-)
No napilla lisäät nyt, mitä olet kirjoittanut soluihin A1, B1 ja C1. Mielestäni järkevin tapa?
alla tarkistettu toimiva koodi
tavalliseen moduuliin..
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
- Tematiikkavastaava
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.Ei Taul2 vaan ...
missä tahansa taulukon solussa ALT F11
sitten VBA editorin puolella valikosta INSERT/MODULE
klikkaa oikealla tyhjää tilaa ja liitä koodi...
VBAProject ikkunassa pitää olla valittuna Modules/Module1 oletuksena (sinisenä)valittuna kun koodin lisäät...
Keep EXCELing
@Kundetää foorumi lisää ylimääräisen rivinvaihdon koodiin
korjaa punaisena olevat rivit seuraavasti:
poista alaviiva ja siirrä kaikki yhdelle riville tyyliin
Function EtsiVika(MitäEtsitään As String, MistäEtsitään As String, MoneskoEsiintymä As Long) As Long
eli toi MoneskoEsiintymä As Long) As Long kanssa samalle riville...
Keep EXCELing
@Kunde
- Tematiikkavastaava
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- lukemattomiavikojasitten
Mikä tuollainen "EtsiVika = 0"... varmaan en tiedä tyttöjen juttuja.
Etsii monia vikoja?
- Tematiikkavastaava
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- Tematiikkavastaava
..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. :)Lisää ActiveX combobox ja suunnittelutilassa tuplaklikkaa komponenttiä ja VBA puolella ominaisuuksisssa(PROPERTIES)
ListRows =20 tai montako riviit haluut näkyville...
ListFillRange=alue mistä tiedot haetaan esim G1:G20
LinkedCell=A1 (B1 ja C1 muilla comboilla)
Keep EXCELing
@Kunde
- Tematiikkavastaava
*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- Tematiikkavastaava
..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.Kyllähän koodissa menee nytkin jo tieto C1 solusta...
pitääkö se nyt vielä pilkko eri riville kommentissa?
- Tematiikkavastaava
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.No eihän sun tartte muuta tehdä kuin C1 laitat kaavan ???
=VK&" "&D1&"-"&E1
koodihan siirtää sen C1 tiedot kommenttiin
Keep EXCELing
@Kunde
- Tematiikkavastaava
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")voit ne lisätä koodiin juuri noin, mutta kun solussa C1 on jo se VK 1-20 tieto ja se siirtyy koodilla.
Miksi haluat vielä lisätä sinne 1 20???
toi =VK&" "&D1&"-"&E1 siis TAUL2 soluun C1 ja muokkaat sitten niitä TAUL2 soluja D1 ja E1
jos sulla on TAUL2 solussa C1= VK JA TAUL2 solussa D1=1 ja TAUL2 solussa E1=20
ja haluat ne kommenttiin lisätä niin sitten
solu.Comment.Text Hakuehto & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1")
& " " & Worksheets("Taul2").Range("D1") & "- " & Worksheets("Taul2").Range("E1")
Keep EXCELing
@Kunde
- Tematiikkavastaava
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.toimii just ihan oikein, mutta et ole lisännyt koodiin kuin yhteen kohtaan & " " & Worksheets("Taul2").Range("D1") & "- " & Worksheets("Taul2").Range("E1")
eli jos ei ole kommenttia niin toimii ok ja sen jälkeen vaan lisää VK, koska et ole lisännyt D ja E solun tietoja koodiin...
2 kohtaan toi rimpsu pitää lisätä vielä ;-)
Keep EXCEling
@Kunde
- lh3ggggeggeee
Visual BASICILLA...
- Tematiikkavastaava
..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.Koodeissa vaihdat
A1--->A2
B1--->B2
C1--->C2
D1--->D2
E1--->E2
ei muuta tartte tehdä...
Keep EXCELing
@Kunde
- Tematiikkavastaava
No sehän olikin helppo juttu. Tnx!
Ketjusta on poistettu 1 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Mikä on kaivattusi etunimi?
Otsikossa siis on kysymys eriteltynä. Vain oikeat vastaukset hyväksytään.1172174En kestä katsoa
Sitä miten sinusta on muut kiinnostuneita. Olen kateellinen. Siksi pitäisi lähteä pois961308Peräti 95 % persujen kannattajista rasisteja
Kertoo EVA:n teettämä kysely. Pakollista yhdenvertaisuuskoulutusta tarvitsee siis paljon laajempi joukko kuin pelkästää3121013Kun viimeksi kohtasitte/näitte
Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...81936- 83906
Olet kyllä vaarallisen himokas
Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.85886On minulla suunitelma
Siitä ei vain tiedä kukaan muu kuin tällä hetkellä minä. Suunnitelma ja varasuunnitelma. Sinun takiasi nainen. Vain s44680Palstan ylivoimaisesti suosituin keskustelunaihe
Palstan suosituin keskustelunaihe näyttää olevan homoseksuaalisuus. Otsikoiden perusteella voisi kuvitella olevansa Seks248667Ei koskaan saatu tuntea
Mitä olisi ollut painautua toisiimme vasten. Hengittää syvään, hyväillä ja rakastella vailla kiirettä. Tai repiä vaattee33660- 50654