hei, tarttis saada aikaiseksi toiminto, jossa soluun kirjoitettu arvo (esim. 0 tai jokin muu merkkijono) laukaisee "hyppytoiminnon" enter painalluksen jälkeen. siirtyminen pitäisi tehdä saman työkirjan eri välilehdelle. näitä hyppysoluja esiintyisi vain tietyissä sarakkeissa (esim. H ja K-sarakkeet).
hyppäys toiselle välilehdelle
kolliko
8666
0Äänestä
Muut lukivat myös
Odottaa vastausta
Näihin keskusteluihin ei ole vielä vastattu. Ole ensimmäinen.
Vastaukset 8
Vanhimmat
muokkaa sopivaksi nyt H ja K sarakkesta pomppaa riippuen solun arvosta
0 ---> Taul2
1 ---> Taul3
teksti ---> Taul3
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Leikkaus As Range
On Error GoTo virhe
Set Leikkaus = Application.Intersect(Target, Range("H:H", "K:K"))
If Not Leikkaus Is Nothing Then
If IsNumeric(Target) Then
Select Case Target
Case 0
Worksheets("Taul2").Activate
Case 1
Worksheets("Taul3").Activate
Case Else
End Select
Else
Worksheets("Taul3").Activate
End If
End If
virhe:
Set Leikkaus = Nothing
End Sub
ok toimii loistavasti. Miten saisin vielä viittauksen tiettyyn soluosoitteeseen siten, että se rivi jossa Taul1:ssä on syötetty siirtymisen laukaiseva arvo säilyy rivinä myös taulukossa Taul2. Vai pitäiskö sallia vain syötteet kakkosriville ja valmiin rivisyötön jälkeen solut siirtyvät esim. "ok" tekstillä yhden pykälän alaspäin? Näin pitäisi sitten tapahtua kaikilla muillakin välilehdillä.
jostain syystä en saanut koodia toimimaan suoraan taulukon moduulissa(hellekö syynä?)
no tää toimii
taulukon moduuliin...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Leikkaus As Range
On Error GoTo virhe
Set Leikkaus = Application.Intersect(Target, Range("H:H", "K:K"))
If Not Leikkaus Is Nothing Then
If IsNumeric(Target) Then
Select Case Target
Case 0
Worksheets("Taul2").Activate
Siirry (Target.Address)
Case 1
Worksheets("Taul3").Activate
Siirry (Target.Address)
Case Else
End Select
Else
Worksheets("Taul3").Activate
Siirry (Target.Address)
End If
End If
virhe:
Set Leikkaus = Nothing
End Sub
moduuliin...
Public Sub Siirry(Solu As String)
ActiveSheet.Range(Solu).Select
End Sub
nyt valitsee aina uudessa taulukossa saman solun kuin mihin tieto syötettiin
Koodi toimii hienosti, mutta unohdinkin mainita, että hyppykriteerinä pitäisi olla merkkijono "EI" ja hyppäys tapahtuukin saman välilehden eri soluun samalle riville mutta esim. 7 saraketta eteepäin. Toivottavasti case lause sallii myös tekstimerkkijont ehdokseen?
tottahan se onnistuu
taulukon moduuliin...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Leikkaus As Range
On Error GoTo virhe
Set Leikkaus = Application.Intersect(Target, Range("H:H", "K:K"))
If Not Leikkaus Is Nothing Then
If IsNumeric(Target) Then
Select Case Targe
Case 0
Worksheets("Taul2").Activate
Siirry (Target.Address)
Case 1
Worksheets("Taul3").Activate
Siirry (Target.Address)
Case Else
End Select
Else
Select Case UCase(Target)
Case "EI"
Worksheets("Taul1").Activate
Siirry (Target.Offset(0, 7).Address)
Case Else
End Select
End If
End If
virhe:
Set Leikkaus = Nothing
End Sub
moduuliin...
Public Sub Siirry(Solu As String)
ActiveSheet.Range(Solu).Select
End Sub
taas ylläri. yhdellä välilehdellä (Taul1) onkin I ja V sarakkeessa hyppäys toiselle välilehdelle sarakkeeseen B lisäksi on yksi hyppäys saman välilehden sarakkeeseen V. Kaikissa näissä tapauksissa hyppykriteerinä on merkkijono "EI".
Toisella välilehdellä (Taul2) onkin kolme hyppäystä samalla välilehdellä oleviin sarakkeisiin B-->G, H-->K ja K-->AV
Elikkä onnistuuko hyppely vaikka käytetään samaa merkkijono kriteerä? Vaiko pitäiskö määritellä syötteeksi EI1, EI2, ...?
ei noilla tiedoilla voi koodia tehdä. Onnistuu pelkällä ei jutullakin mutta vaatii solun mistä hypätään minnekin, Jos haluat ratkaisun niin lähetä tiedosto ja kaikki hypyt emaililla [email protected]
tässä koodi, jota voidaan käyttää esim. kun tallennetaan lomaketietoja taulukkoon ja halutaan että tietty lukuarvo (esim. ei vastaus) siirtää kursorin x saraketta eteenpäin. Voi olla hyödyllinen toiminto kun tallennettavia lomakkeita on > 1000kpl. Huom. tässä hypellään saman välilehden sisällä.
'taulukon koodiin
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Leikkaus As Range
On Error GoTo virhe
Dim sarakkeet(), hypyt()
'määritetään vektoriin tutkittavat sarakkeet
sarakkeet = Array("I:I", "O:O", "V:V", "AC:AC", "AI:AI", "AL:AL")
'tallennetaan hyppymäärät vektoriin
hypyt = Array(20, 7, 7, 5, 3, 37)
Dim i
For i = LBound(sarakkeet) To UBound(sarakkeet)
Set Leikkaus = Application.Intersect(Target, Range(sarakkeet(i)))
If Not Leikkaus Is Nothing Then
If IsNumeric(Target) Then
If Target = 0 Then
Worksheets("Taul1").Activate
Siirry (Target.Offset(0, hypyt(i)).Address)
End If
End If
End If
Next
virhe:
Set Leikkaus = Nothing
End Sub
'modulinkoodiin
Public Sub Siirry(Solu As String)
ActiveSheet.Range(Solu).Select
End Sub