25. januar 2002 - 16:03
#16
Denne her kan udvides og udvides og udvides efter behov
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Jumper As Range
Dim JumpCells1 As Range
Dim JumpCells2 As Range
Dim bJump1 As Boolean
Dim bJump2 As Boolean
Dim NumberOfStartCells As Long
Dim Counter As Long
'NOTER dig at sidste celle i JumpCells1 er den samme celle som første celle i JumpCells2
'MAX længde af JumpCells' Range er 255 karakter, så ingen unødige mellemrum
'Er du i tvivl om længden, så paste a1,A2....i8,i9 ind i en celle og lad en anden celle tælle =LÆNGDE(xx)
Set JumpCells1 = Range("a1,A2,A3,A4,a5,A6,a7,a8,a9,b1,b2,b3,b4,b5,b6,b7,b8,b9,c1,c2,c3,c4,c5,c6,c7,c8,c9,d1,d2,d3,d4,d5,d6,d7,d8,d9,e1,e2,e3,e4,e5,e6,e7,e8,e9,f1,f2,f3,f4,f5,f6,f7,f8,f9,g1,g2,g3,g4,g5,g6,g7,g8,g9,h1,h2,h3,h4,h5,h6,h7,h8,h9,i1,i2,i3,i4,i5,i6,i7,i8,i9")
Set JumpCells2 = Range("i9,j1,j2,j3,j4,j5,j6,j7,j8,j9,k1,k2,k3,k4,k5,k6,k7,k8,k9,l1,l2,l3,l4,l5,l6,l7,l8,l9,m1,m2,m3,m4,m5,m6,m7,m8,m9,n1,n2,n3,n4,n5,n6,n7,n8,n9,o1,o2,o3,o4,o5,o6,o7,o8,o9,p1,p2,p3,p4,p5,p6,p7,p8,p9,q1,q2,q3,q4,q5,q6,q7,q8,q9,r1,r2,r3,r4,r5,r6,r7,r8,r9")
NumberOfStartCells = 1
If Not Intersect(Target, JumpCells1) Is Nothing Then
bJump1 = True
Set Jumper = JumpCells1
End If
If Not Intersect(Target, JumpCells2) Is Nothing Then
bJump2 = True
Set Jumper = JumpCells2
End If
If bJump1 Or bJump2 Then
For Counter = 1 To Jumper.Areas.Count - NumberOfStartCells
If Not Intersect(Target, Jumper.Areas(Counter)) Is Nothing Then
Jumper.Areas(Counter + NumberOfStartCells).Activate
Exit For
End If
Next Counter
End If
Set Jumper = Nothing
Set JumpCells1 = Nothing
Set JumpCells2 = Nothing
End Sub