Office: Relatives Makro

jahnse · 29. September 2013

Hallo Leute,
ich hab ne Datei, in der in einer Spalte Hyperlinks stehen, und eine andere, in der der Preis stehen soll, der auf der Website angezeigt wird.

Inzwischen habe ich mit einem Makro die Hyperlinks direkt als Text eine Spalte weiter eingetragen.

Was ich nicht hinbekomme:
Jetzt würde ich gern alles mit einem Makro machen. Vom Ablauf soll es ungefähr Folgendes machen:
Ich markiere das Feld wo der Preis stehen soll. Das Makro kopiert den Text (den direkten Hyperlink) 5 Felder weiter rechts, öffnet Tabelle 2 und erstellt in A1 einen Abruf aus dem Web mit dem kopierten Hyperlink, der die ganze Seite einfach nimmt.

Den Rest krieg ich selber hin. Also, dass ich die Daten auslese. Nur ich weiß eben nicht, wie ich ihm verklickere, dass er keinen festen Hyperlink nimmt, sondern immer den der 5 Spalten weiter rechts steht.

Danke auf jeden Fall
Grüße
jahnse

:)

OfficeUser · 1. Oktober 2013

Hallo jahnse,

ich weiß nicht, ob ich das ganz richtig verstanden habe, aber ich würde das so lösen, angenommen die Preise in Tabelle 1 stehen in Spalte A und die zugehörigen Hyperlinks in Spalte F, dann Doppelklick auf die Zelle mit dem Preis und der Hyperlink wird in Tabelle2!A1 eingetragen: Code:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim strLink As String

If Target.Column = 1 Then
strLink = Target.Offset(0, 5)
Worksheets("Tabelle2").Hyperlinks.Add Anchor:=Worksheets("Tabelle2").Range("A1"), Address:=strLink, TextToDisplay:=strLink
Cancel = True
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Tabelle1

A B C D E F
1 Preis Hyperlink
2 500,00 www.microsoft.de
Excel Tabellen im Web darstellen >>

jahnse · 1. Oktober 2013

Hallo Hasso,
Danke für die Antwort.
Das ist aber leider nicht das was ich brauche. Sry, hab mich wohl unklar ausgedrückt.

Ich möchte einen Preis, der auf einer Website steht auslesen.

Ich hab das versucht über "externe Daten abrufen".
Aber wenn ich das als Makro aufnehme, fügt er nicht das ein, was ich vorher kopiert habe, sondern den festen Link.

Also:
Code:

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;VDE 0022:2008-08 - Normen - VDE VERLAG", _
Destination:=Range("$A$1"))
.Name = "vde-0022-2008-08_1"
.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
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Statt "VDE 0022:2008-08 - Normen - VDE VERLAG" soll aber der relative Link rein.

Da hab ich leider zu wenig Ahnung von VBA, um das zu können.

Danke und Grüße aus dem Norden
jahnse

Hasso · 1. Oktober 2013

Hallo jahnse,

Statt "VDE 0022:2008-08 - Normen - VDE VERLAG" soll aber der relative Link rein.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wo steht denn in deinem Tabellenblatt die Linkadresse?
Mal angenommen, sie stünde in Tabelle1!A1, dann müsstest du im Code schreiben Code:

With ActiveSheet.QueryTables.Add(Connection:= Worksheets("Tabelle1").Range("A1"), _
Destination:=Range("$A$1"))
.Name = "vde-0022-2008-08_1"
.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
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

jahnse · 1. Oktober 2013

Moin,
Ich hätte gleich ne Beispieltabelle machen sollen, dann ist das klarer. =)
Danke auf jeden Fall für deine Mühe
Grüße
jahnse

EDIT: Diese Antwort betrachtet den Code vorher noch nicht.

Hasso · 1. Oktober 2013

Hallo jahnse,

Ich hätte gleich ne Beispieltabelle machen sollen, dann ist das klarer. =)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Sehr gute Erkenntnis!

Ich habe das jetzt mit folgendem Code gelöst: Code:

Option Explicit

Sub DatenAbrufen()

Dim intZeile As Integer

'alte Werte auf Tabelle2 löschen:
Worksheets("Tabelle2").UsedRange.Delete
'Daten abrufen, die URL steht in "Tabelle1" Zelle AI3:
With Worksheets("Tabelle2").QueryTables.Add(Connection:="URL;" & _
Worksheets("Tabelle1").Range("AI3") & "", Destination:=Worksheets("Tabelle2").Range("$A$1"))
.Name = "vde-0022-2008-08"
.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
'Die Zeile mit "PREVIEW" suchen:
intZeile = Application.WorksheetFunction.Match("PREVIEW", Worksheets("Tabelle2").Range("A1:A410"), 0)
'Wert der Zelle darunter in AD3 und AH3 eintragen:
Worksheets("Tabelle1").Range("AH3,AD3") = Worksheets("Tabelle2").Cells(intZeile + 1, 1)
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Jetzt wüsste ich nur noch gerne, wie der Abruf ausgelöst werden soll (durch einen Button oder Doppelklick auf die Preiszelle oder was?)
Ich habe das jetzt mit Doppelklick auf AD3 festgelegt. Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Address = "$AD$3" Then
Call DatenAbrufen
Cancel = True
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hasso · 1. Oktober 2013

Hallo jahnse,

man kann den Hyperlink übrigens auch direkt aus Zelle D3 auslesen: Code:

Option Explicit

Sub DatenAbrufen()

Dim intZeile As Integer

'alte Werte auf Tabelle2 löschen:
Worksheets("Tabelle2").UsedRange.Delete
'Daten abrufen, der Link steht in "Tabelle1" Zelle D3:
With Worksheets("Tabelle2").QueryTables.Add(Connection:="URL;" & _
Worksheets("Tabelle1").Range("D3").Hyperlinks(1).Address & "", _
Destination:=Worksheets("Tabelle2").Range("$A$1"))
.Name = "vde-0022-2008-08"
.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
'Die Zeile mit "PREVIEW" suchen:
intZeile = Application.WorksheetFunction.Match("PREVIEW", Worksheets("Tabelle2").Range("A1:A410"), 0)
'Wert der Zelle darunter in AD3 und AH3 eintragen:
Worksheets("Tabelle1").Range("AH3,AD3") = Worksheets("Tabelle2").Cells(intZeile + 1, 1)
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

jahnse · 2. Oktober 2013

WOW =D
Danke, das macht alles soo viel einfacher.
Ich hab das Ganze mit meinem Halbwissen quasi noch relativiert.

Code:

Sub DatenAbrufen()

Dim intZeile As Integer

'alte Werte auf Tabelle1 löschen:
Worksheets("Tabelle1").UsedRange.Delete
'Daten abrufen, der Link steht in "BMA-Elektro-Normen" Spalte D:
With Worksheets("Tabelle1").QueryTables.Add(Connection:="URL;" & _
Worksheets("BMA-Elektro-Normen").Range(ActiveCell, ActiveCell.Offset(0, -26)).hyperlinks(1).Address & "", _
Destination:=Worksheets("Tabelle1").Range("$A$1"))
.Name = "vde-0022-2008-08"
.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
'Die Zeile mit "Preview" suchen:
intZeile = Application.WorksheetFunction.Match("Preview", Worksheets("Tabelle1").Range("A1:A410"), 0)
'Wert der Zelle darunter in AD eintragen:
Worksheets("BMA-Elektro-Normen").Range(ActiveCell, ActiveCell) = Worksheets("Tabelle1").Cells(intZeile + 1, 1)
ActiveCell.Offset(1, 0).Range("A1").Select

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit freundlichen Grüßen
jahnse

Office: Relatives Makro

Relatives Makro

Relatives Makro

Relatives Makro

Relatives Makro

Relatives Makro - Similar Threads - Relatives Makro

VBA-Makro mit relativen Zellbezügen?

Speichern unter Makro: automatisch relative Pfadangabe?

Makro mit absoluten und relativen Koordinaten

Relativer Bezug bei Makro für Diagramme

Formel in Makro relativ weit runterziehen

Makro soll relativen Bereich mit Daten füllen

Makro aufzeichnen,Wechsel zw. relativen und absoluten Bezug