Data fra DGS eller KRAK til excel

Krak har en webservice, hvor du kan få oplysningerne fra. Prøv at kontakte dem.

Du kunne lave en midlertidig webimport med en makro i et nyt regneark, tage de data du skal bruge, og slette arket.

Et simpelt forslag:

Sub Makro()
   
    Nr = Selection
    Fuldadresse = Selection.Address
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.krak.dk/Person/Resultat.aspx?Who=" & Nr & "&WhoOnlySearch=false&ExtendSearch=false" _
        , Destination:=Range("A1"))
        .Name = _
        "Kort.aspx?Who=" & Nr & "&WhoOnlySearch=false&ExtendSearch=false"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Navn = Range("A24").Value
    Adresse = Range("A25").Value & " " & Range("A26").Value
   
   
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
   
    Range(Fuldadresse).Offset(0, 1).Select
    Range(Fuldadresse).Offset(0, 1).Value = Navn
    Range(Fuldadresse).Offset(0, 2).Value = Adresse
   
End Sub

Stil dig på en celle, hvor der står et telefonnr. Kør makroen. Navn & adresse skrives til højre for.

Hej med jer!
Det er smart! og det virker ;-))
Kan man (hvis jeg giver point!) ændre ovenstående således at der er et felt "kun" med postnummeret (UDEN bynavnet)?
DVS. et felt med telefonnummeret jeg taster ind, et med Navn, et med Adresse, og et med Postnummer!?

Hvis du skriver alle oplysningerne ind, hvad skal den så lede efter?

Hvis du sætter et ' foran ActiveSheet.Delete, kan du i det midlertidige ark se hvilke data der bliver hentet fra Krak.

Jeg skriver telefonnummeret, kører makroen,
i næste celle hentes navn, næste celle hentes adresse, næste celle postnummer
håber det er forklaring nok ;-))

Det burde være sådan (ikke afprøvet):

Sub Makro()
   
    Nr = Selection
    Fuldadresse = Selection.Address
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.krak.dk/Person/Resultat.aspx?Who=" & Nr & "&WhoOnlySearch=false&ExtendSearch=false" _
        , Destination:=Range("A1"))
        .Name = _
        "Kort.aspx?Who=" & Nr & "&WhoOnlySearch=false&ExtendSearch=false"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Navn = Range("A24").Value
    Adresse = Range("A25").Value
    Postnr = Range("A26").Value

   
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
   
    Range(Fuldadresse).Offset(0, 1).Select
    Range(Fuldadresse).Offset(0, 1).Value = Navn
    Range(Fuldadresse).Offset(0, 2).Value = Adresse
    Range(Fuldadresse).Offset(0, 3).Value = Postnr

End Sub

Postnummer og bynavn er i samme felt,
jeg ønsker et felt "kun" med postnummeret.

Sub Makro()
   
    Nr = Selection
    Fuldadresse = Selection.Address
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.krak.dk/Person/Resultat.aspx?Who=" & Nr & "&WhoOnlySearch=false&ExtendSearch=false" _
        , Destination:=Range("A1"))
        .Name = _
        "Kort.aspx?Who=" & Nr & "&WhoOnlySearch=false&ExtendSearch=false"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Navn = Range("A24").Value
    Adresse = Range("A25").Value
    PostNrBy = Range("A26").Value
    PostNrBy = Split(PostNrBy, " ", 2)

   
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
   
    Range(Fuldadresse).Offset(0, 1).Select
    Range(Fuldadresse).Offset(0, 1).Value = Navn
    Range(Fuldadresse).Offset(0, 2).Value = Adresse
    Range(Fuldadresse).Offset(0, 3).Value = PostNrBy(0)
    Range(Fuldadresse).Offset(0, 4).Value = PostNrBy(1)

End Sub

Hej akyhne,
Så virker det perfekt, Tak for hjælp!
Jeg har oprettet et spørgsmål du kan svare på
så du kan få dine point!

Tak for hjælp & god weekend
Rasmus O.

Æhh, du skal bare acceptere mit svar her - nederst på siden.

http://www.racingcar.dk/eksperten/svar/svar.html

rasmuso: Er jberiksen også din konto?

Nix!
Derfor har jeg oprettet et nyt spørgsmål til dig, så du kan få point fra mig.
(jeg var bare med på "en kigger"!)

Ok, men det tror jeg ikke giver mig ret til at trække point fra dig. Jeg var ikke opmærksom på du ikke var spørger.

jberiksen: Kunne du bruge det?

Undskyld den sene tilbagemelding, men har været på ferie og haft andet at se til da jeg kom hjem.
Takker mange gange for hjælpen, det var fuldt ud brugbart

Jeg har prøvet denne tråd men jeg får en fejlmelding når jeg bruger denne makro. Ser ud til problemet skal finde i denne sektion   

With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.krak.dk/ (...) & Nr & "&WhoOnlySearch=false&ExtendSearch=false" _
        , Destination:=Range("A1"))

Var lige præcis hvad jeg har brug for, så håber at der stadig er nogen som har viden inden for dette.

Michael