12. august 2017 - 11:14 Der er 4 kommentarer og
1 løsning

Link

Nu har jeg forsøgt med Google og Microsoft uden at finde en løsning, så nu prøver jeg eksperten :)

Jeg har et lille makro i et regneark:

Sub ListData()
Dim LastRow, x, y As Integer
LastRow = Worksheets("ark1").Cells(120000, 3).End(xlUp).Row
y = 3
For x = 1 To LastRow
If Worksheets("ark1").Cells(x, 3) = Range("a2") Then
Cells(y, 1) = Worksheets("ark1").Cells(x, 5)
Cells(y, 2) = Worksheets("ark1").Cells(x, 6)
Cells(y, 3) = Worksheets("ark1").Cells(x, 7)
y = y + 1
End If
Next
End Sub

Den løber ark1 igennem og hvis den finder et match cellen, så skriver den det der står i celle 5-7 i en række. Ingen problemer.
Nu kunne det så være super, hvis den i delle(x,8) lavede et hyperlink til ark1, kollonne A. Altså skal den i cellen skrive =hyperlink(cells(x,8).
Hvis jeg går op under indsæt og indsætter et hyperlink, så virker det fint. Hvis jeg prøver at skrive den samme tekst i formlen hyperlink, så virker det ikke? :(
Jan Hansen Guru
12. august 2017 - 19:03 #1
hvad med noget alla :
Worksheets("ark1").Hyperlinks.Add SubAddress:= _
        Worksheets("ark1").Cells(x, 8) , TextToDisplay:=cells(y,4)

ej testet

Jan
12. august 2017 - 20:08 #2
det tror jeg ikke. Jeg ønsker, at skrive noget i celle x,8 som virker som et link til et andet sted i mit dok !!
jens48 Guru
12. august 2017 - 22:40 #3
Jeg er ikke helt sikker på at jeg forstår dig korrekt, men check om dette er noget du kan bruge:

Sub ListData()
Dim LastRow, x, y As Integer
LastRow = Worksheets("Ark1").Cells(120000, 3).End(xlUp).Row
y = 3
For x = 1 To LastRow
If Worksheets("Ark1").Cells(x, 3) = Range("A2") Then
Cells(y, 1) = Worksheets("Ark1").Cells(x, 5)
Cells(y, 2) = Worksheets("Ark1").Cells(x, 6)
Cells(y, 3) = Worksheets("Ark1").Cells(x, 7)
Cells(y, 8).Select
ActiveSheet.Hyperlinks.Add ActiveCell, "", Sheets("Ark1").Name & "!A" & x
y = y + 1
End If
Next
End Sub
Jan Hansen Guru
13. august 2017 - 02:16 #4
Prøv om du ikke kan bruge denne som udgangs punkt:



Option Explicit

Sub ListData()
Dim LastRow, x, y As Integer
Dim ws_1 As Worksheet: Set ws_1 = Sheets("Ark1")
Dim ws_2 As Worksheet: Set ws_2 = Sheets("Ark2")
LastRow = ws_1.Cells(120000, 3).End(xlUp).Row
y = 3
For x = 1 To LastRow
    If ws_1.Cells(x, 3) = ws_2.Range("a2") Then
        ws_2.Cells(y, 1) = ws_1.Cells(x, 5)
        ws_2.Cells(y, 2) = ws_1.Cells(x, 6)
        ws_2.Cells(y, 3) = ws_1.Cells(x, 7)
        '----
        ' Anchor:=        (Adresse til celle linket skal stå i)  SubAddress:=    (fuld adresse til celle)  TextToDisplay:=      (Tekst de skal stå som hyberlink)
        '----
        ActiveSheet.Hyperlinks.Add Anchor:=ws_2.Cells(y, 8), Address:="", SubAddress:=ws_1.Name & "!" & ws_1.Cells(x, 3).Address, TextToDisplay:="Link"
        y = y + 1
    End If
Next
End Sub


Jan
13. august 2017 - 08:17 #5
Mange tak Jens. Det virkede bare i første forsøg - uden tilretning :)
Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links

Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester





Computerworld
Medie: Apple Pay bliver lanceret i Danmark i næste uge
Nordea og Apple vil i næste uge lancere Apple Pay i Danmark, hvis man skal tro svensk medie
CIO
"På 11 minutter blev vores computere ramt af den frygtede Petya ransomware-skærm"
"På 11 minutter blev vores computere ramt af den frygtede Petya ransomware-skærm. Først troede vi, at det bare ville blive en aften uden email, og at de ville fikse det i løbet af natten. Men næste morgen var der krisemøde, og vi fik at vide, at vi ville være nede i lang tid."
Comon
Anmeldelse: Livet som superhelt i Midgård er stadig fornøjeligt
Shadow of War bygger videre på alle de solide kvaliteter fra forgængeren, og lader dig agere action-stjerne i Tolkiens univers.
Job & Karriere
IBM’s Watson har gennemlæst 600 jobopslag, og snart kan der blive vendt op og ned på vores jobsøgning
Kunstig intelligens kan forandre den måde virksomheder rekrutterer på. Derfor har IBM netop gennemført et stort forsøg med Danmarks største erhvervsskole.
White paper
Er din virksomhed (måske) på vej ud i skyen? … her er tre mulige strategier og alle de vigtigste overvejelser
For langt de fleste virksomheder er cloud en uundgåelig del af fremtiden. Men hvordan skal man gribe det projekt an? Dette whitepaper fra EG fyldt med værdifulde input til de virksomheder, som står på tærsklen til at tage beslutningen - analyser, refleksioner, opmærksomhedspunkter og anbefalinger, som kan være en støtte i overvejelserne og undersøgelsen forud for beslutningen.