/ Forside/ Teknologi / Administrative / MS-Office / Spørgsmål
Login
Glemt dit kodeord?
Brugernavn 

Kodeord  


Reklame
Top 10 brugere
MS-Office
#NavnPoint
sion 18609
refi 14474
Klaudi 8489
Rosco40 5695
berpox 5456
dk 5398
Benjamin... 4870
webnoob 4747
o.v.n. 4637
10  EXTERMINA.. 4373
Trække data fra hjemmeside til excel
Fra : hojriiskim
Vist : 259 gange
85 point
Dato : 21-10-14 08:59

Jeg arbejder på at trække data fra denne hjemmeside:
http://www.toyodiy.com/parts/xref?s=

På hjemmeside kan reservedelsnumre slåes op. Et eksempel kunne være 47771-32010. Resultatsiden for søgningen findes på den nævnte URL+det reservedelsnummer man vil søge på - Eksempelvis: http://www.toyodiy.com/parts/xref?s=47771-32010

På siden fremkommer en tabel med følgende kolonner:
Date range    Model   Frames/Options   Found in diagram

Jeg vil gerne trække tabellens informationer over i Excel hvor jeg kan sortere og søge i data.
Jeg kan sagtens gøre dette ved hjælp af funktionen "Data --> Fra internettet" i excel. Men her gør jeg det for et reservedelsnummer. Jeg kunne godt tænke mig at have en kolonne med reservedelsnumre som den så automatisk søger op når jeg klikker på en knap.

Jeg har kigget en del på nettet/youtube, men ikke lige fundet løsningen. Jeg forestiller mig noget med at første ark indeholder listen med reservedelsnumre (kolonne A) og en beskrivelse (kolonne B) og at resultatet vises i ark 2.

På ark to kunne jeg godt tænke mig at resultatet blev vist efter dette format:
Kolonne A: Reservedelsnummer (fra ark 1)
Kolonne B: Beskrivelse (fra ark 1)
Kolonne C: Date range (fra webside)
Kolonne D: Model (fra webside)
Kolonne E: Frame/Option (fra webside)
Kolonne F: Found in diagram (fra webside)

Da der er stor forskel på antallet af rækker der returneres fra en søgning, vil jeg gerne have reservedelsnummer og bekrivelse (Kolonne A og B) med hele vejen ned på alle de rækker der høre til den enkelte søgning.
Sidst men ikke mindst vil jeg gerne have alle resultater i samme ark og lige efter hinanden.

Er der nogen der kan lede mig i den rigtige retning? På forhånd tak!

Jeg ved dette er et svært spørgsmål, men jeg har desværre ikke flere point. :)


 
 
Kommentar
Fra : Brassovitski


Dato : 21-10-14 10:50

Pointene er ikke afgørende. Det er i hvert fald en lidt spændende opgave.
Forstår jeg rigtig at du ønsker ud fra et reservedels nummer i Excel, som du klikker på så få en liste hentet ind i Excel fra hjemmesiden, lignende den du linker til?
Umiddelbart vil jeg mene at du bør importere hele reservedels-kataloget far hjemmesiden, og så lave det i Excel som du ønsker, det kræver jo så blot en jævnlig opdatering.
Denne funktion kunne jeg da godt tænke mig at vide lidt mere om, hvor finder du den på båndet?
Citat
funktionen "Data --> Fra internettet"

Hvis vi antager at du har en celle med reservedels-nummeret, vil jeg mene du skal lægge denne url: http://www.toyodiy.com/parts/xref?s= sammen med reservedelsnummeret, og lave den til et link, som henter data. Det må være første skridt? Og jeg tror ikke det kan lade sig gøre uden der skal programmeres noget makro, og det er ikke lige mit special område.
Jeg e rikke helt hundrede med på hvad du præcis ønsker, selv om du har beskrevdet der temmelig nøjagtig. Du skal nok have en ind over der er skrap til VBA i Excel.

Kommentar
Fra : hojriiskim


Dato : 21-10-14 11:51

Jeg vil gerne have at jeg kan sætte en kolonne ind med reservedelsnumre (ca 500 stk). Når jeg så køre en makro (eller hvad det nu er der skal til), så henter den data fra hjemmesiden for alle disse 500 reservedelsnumre. Det kan også være en lidt mere manuel metode, hvor jeg når jeg har tasted reservedelsnummeret, klikker på en knap eller noget, og derved henter data for dette nummer.
For mig er det mest afgørende i denne situation at den automatisk tilføjer de hentede data til et ark så jeg ikke selv skal klippe/kopiere til og fra ark og samle sammen.

Kommentar
Fra : hojriiskim


Dato : 21-10-14 16:53

Jeg finder i øvrigt funktionen i båndet under "Data" --> "Hent eksterne data" --> "Fra internettet"

Kommentar
Fra : hojriiskim


Dato : 21-10-14 19:19

Så langt så godt. Nu har jeg lavet det sådan at den slår op 5 gange (i felterne har jeg det fulde URL - sammensat af førstnævnte URL og et reservedelsnummer) og indsætter data på arket "Samlet". Men den smider bare data ind efter hinanden ud af i kolonnerne. Så første opslag står i række 2 kolonne B-E, næste opslag står i række 2 kolonne F-I osv...

Jeg vil hellere have alle resultater i kolonne B-E og så kommer de enkelte opslag under hinanden i rækkerne. Jeg lurer på om jeg kan lave noget med at sætte Range til "Kolonne: B, Række: Næste tomme række".

Nogen der kan hjælpe med det?

Her er koden indtil nu:

Sub adds()
For x = 1 To 5
Worksheets("Ark1").Select
Worksheets("Ark1").Activate
mystr = "URL;http://www.toyodiy.com/parts/xref?s=47771-32010"
mystr = Cells(x, 1)
Worksheets("Samlet").Select
Worksheets("Samlet").Activate

With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'.CommandType = 0
.Name = "xref?s=47771-32010"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next x
End Sub


Kommentar
Fra : hojriiskim


Dato : 21-10-14 22:20

Det er nu lykkedes. Min kode blev:
Sub adds()

Worksheets("Samlet").Select
Worksheets("Samlet").Activate
ActiveSheet.Cells.Clear

For x = 1 To 5
Worksheets("Input").Select
Worksheets("Input").Activate
mystr = "URL;http://www.toyodiy.com/parts/xref?s=47771-32010"
mystr = Cells(x, 1)
Worksheets("Samlet").Select
Worksheets("Samlet").Activate
Range("A2").Select
Rows("1:20").Insert Shift:=xlDown
ActiveWorkbook.Sheets("Samlet").Range("A1").Value = mystr

With Sheets("Samlet").Range("A1")
If Left(.Value, 1) = "U" Then .Value = Right(.Value, Len(.Value) - 40)
End With

With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'.CommandType = 0
.Name = "xref?s=47771-32010"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

ActiveSheet.UsedRange.Select
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

End With

Next x

Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"



Worksheets("Samlet").Select
Worksheets("Samlet").Activate
Columns("A").ColumnWidth = 15
Columns("B").ColumnWidth = 15
Columns("C").ColumnWidth = 26
Columns("D").ColumnWidth = 39
Columns("E").ColumnWidth = 47

End Sub


På "input" angiver jeg stien til den tabel jeg ønsker for en bestemt reservedel.
På "samlet" kommer resultatet ud.

Annuller spørgsmålet
Fra : hojriiskim


Dato : 21-10-14 22:21

Jeg har desværre ikke modtaget et gyldigt svar, og annullerer derfor dette spørgsmål

Jeg kom dog selv frem til denne kode:
Sub adds()

Worksheets("Samlet").Select
Worksheets("Samlet").Activate
ActiveSheet.Cells.Clear

For x = 1 To 5
Worksheets("Input").Select
Worksheets("Input").Activate
mystr = "URL;http://www.toyodiy.com/parts/xref?s=47771-32010"
mystr = Cells(x, 1)
Worksheets("Samlet").Select
Worksheets("Samlet").Activate
Range("A2").Select
Rows("1:20").Insert Shift:=xlDown
ActiveWorkbook.Sheets("Samlet").Range("A1").Value = mystr

With Sheets("Samlet").Range("A1")
If Left(.Value, 1) = "U" Then .Value = Right(.Value, Len(.Value) - 40)
End With

With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'.CommandType = 0
.Name = "xref?s=47771-32010"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

ActiveSheet.UsedRange.Select
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

End With

Next x

Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"



Worksheets("Samlet").Select
Worksheets("Samlet").Activate
Columns("A").ColumnWidth = 15
Columns("B").ColumnWidth = 15
Columns("C").ColumnWidth = 26
Columns("D").ColumnWidth = 39
Columns("E").ColumnWidth = 47

End Sub


Du har følgende muligheder
Dette spørgsmål er blevet annulleret, det er derfor ikke muligt for at tilføje flere kommentarer.
Søg
Reklame
Statistik
Spørgsmål : 173634
Tips : 31664
Nyheder : 719565
Indlæg : 6383599
Brugere : 218258

Månedens bedste
Årets bedste
Sidste års bedste