Thema Datum  Von Nutzer Rating
Antwort
24.07.2019 16:44:31 Jan
NotSolved
24.07.2019 17:48:31 Gast7777
NotSolved
25.07.2019 09:55:49 Gast56852
NotSolved
Blau Werte in der Excel Tabelle wiederholen sich
27.07.2019 14:32:06 Gast48456
NotSolved
25.07.2019 13:04:01 Torsten
NotSolved
26.07.2019 11:14:35 Jan
NotSolved
25.07.2019 13:15:17 Torsten
NotSolved

Ansicht des Beitrags:
Von:
Gast48456
Datum:
27.07.2019 14:32:06
Views:
440
Rating: Antwort:
  Ja
Thema:
Werte in der Excel Tabelle wiederholen sich

Schreit gerade danach PowerQuery zu benutzen. VBA ist da überhaupt nicht notwendig ... sogar ehern umständlich.

Wenn du dich nur mit VBA beschäftigst um Daten zu importieren, würde ich dir ehern dazu raten dich mit PowerQuery zu beschäftigen, da dies dir mächtige Werkzeuge bereitschellt die du in VBA erst umständlich selbst erstellen müsstest. Ohne PowerQuery nicht zu beherschen/verstehen, kannst du es auch in VBA nicht nutzen.

Beachte deshalb bitte, dass das folgende Makro nur dazu dient, dir die Abfragen zu erstellen damit du dir das mal Live ansehen kannst. Das Makro ist sonst absolut irrelevant und nicht für den Datenimport notwendig (der Import funktioniert also auch in einer Mappe frei von Makros).

Die Abfragen, die das Makro - Du musst einmalig YahooWebRequest_Init ausführen - erstellt, findest du dann hier:

Per Doppelklick, auf eine der Abfragen, kannst du sie einsehen/bearbeiten.

 

Option Explicit

Private Const C_YAHOO_REQUEST_FUNC_NAME     As String = "fYahooFinanceStats"
Private Const C_YAHOO_REQUEST_TABLE_NAME    As String = "tYahooFinanceStats"
Private Const C_TABLE_RANGE_NAME            As String = "tAktien"

Public Sub YahooWebRequest_CleanUp()
  On Error Resume Next
  ThisWorkbook.Queries(C_YAHOO_REQUEST_TABLE_NAME).Delete
  ThisWorkbook.Queries(C_YAHOO_REQUEST_FUNC_NAME).Delete
  ThisWorkbook.Names(C_TABLE_RANGE_NAME).Delete
End Sub

Public Sub YahooWebRequest_Init()
  
  Debug.Print "#"; Time$; "#", "[START]"
  
  Dim rngTableCol1 As Excel.Range
  Dim objQuery As WorkbookQuery
  Dim strQuery As String
  
  With ThisWorkbook.Worksheets("Tabelle1")
    'Datenbereich der Aktien-Spalte mit Kopfzeile
    Set rngTableCol1 = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
    Call .Parent.Names.Add(C_TABLE_RANGE_NAME, rngTableCol1) 'Bereich mit Namen versehen
  End With

'#
'# YAHOO_REQUEST_FUNC
'#
  strQuery = "let " & C_YAHOO_REQUEST_FUNC_NAME & " = (aktie as text) =>" & vbNewLine & _
                "let" & vbNewLine & _
                    "Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/""&aktie&""?p=""&aktie))," & vbNewLine & _
                    "Data0 = Source{0}[Data]," & vbNewLine & _
                    "Data0_Transposed = Table.Transpose(Data0)," & vbNewLine & _
                    "Data0_WithHeader = Table.PromoteHeaders(Data0_Transposed, [PromoteAllScalars=true])," & vbNewLine & _
                    "Data0_DataTypes = Table.TransformColumnTypes(Data0_WithHeader,{{""Previous Close"", Number.Type}}, ""en-US"")," & vbNewLine & _
                    "Data0_Selected = Table.SelectColumns(Data0_DataTypes,{""Previous Close""})" & vbNewLine & _
                "in" & vbNewLine & _
                    "Data0_Selected" & vbNewLine & _
              "in" & vbNewLine & _
                  C_YAHOO_REQUEST_FUNC_NAME
  
  On Error Resume Next
  Set objQuery = Nothing
  Set objQuery = ThisWorkbook.Queries(C_YAHOO_REQUEST_FUNC_NAME)
  On Error GoTo 0
  
  If Not objQuery Is Nothing Then
    Debug.Print "#"; Time$; "#", "use existing '"; C_YAHOO_REQUEST_FUNC_NAME; "'"
  Else
    Debug.Print "#"; Time$; "#", "create '"; C_YAHOO_REQUEST_FUNC_NAME; "'"
    Set objQuery = ThisWorkbook.Queries.Add(C_YAHOO_REQUEST_FUNC_NAME, strQuery)
  End If
  
'#
'# YAHOO_REQUEST_TABLE
'#
  strQuery = "let" & vbNewLine & _
                "Data0 = Excel.CurrentWorkbook(){[Name=""" & C_TABLE_RANGE_NAME & """]}[Content]," & vbNewLine & _
                "Data0_WithHeaders = Table.PromoteHeaders(Data0, [PromoteAllScalars=true])," & vbNewLine & _
                "Data0_DataTypes = Table.TransformColumnTypes(Data0_WithHeaders,{{""Aktie"", type text}})," & vbNewLine & _
                "Data0_UDF_CALL = Table.AddColumn(Data0_DataTypes, """ & C_YAHOO_REQUEST_FUNC_NAME & """, each " & C_YAHOO_REQUEST_FUNC_NAME & "([Aktie]))," & vbNewLine & _
                "Data0_SelectColumns = Table.ExpandTableColumn(Data0_UDF_CALL, """ & C_YAHOO_REQUEST_FUNC_NAME & """, {""Previous Close""}, {""Previous Close""})" & vbNewLine & _
             "in" & vbNewLine & _
                "Data0_SelectColumns"
  
  On Error Resume Next
  Set objQuery = Nothing
  Set objQuery = ThisWorkbook.Queries(C_YAHOO_REQUEST_TABLE_NAME)
  On Error GoTo 0
  
  If Not objQuery Is Nothing Then
    Debug.Print "#"; Time$; "#", "use existing '"; C_YAHOO_REQUEST_TABLE_NAME; "'"
  Else
    Debug.Print "#"; Time$; "#", "create '"; C_YAHOO_REQUEST_TABLE_NAME; "'"
    Set objQuery = ThisWorkbook.Queries.Add(C_YAHOO_REQUEST_TABLE_NAME, strQuery)
  End If
  
'#
'# FETCH and DISPLAY data
'#
  With ActiveWorkbook.Worksheets.Add
    With .ListObjects.Add( _
        SourceType:=xlSrcExternal, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & C_YAHOO_REQUEST_TABLE_NAME, _
        Destination:=.Range("$A$1") _
      )
      With .QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & C_YAHOO_REQUEST_TABLE_NAME & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        
        Debug.Print "#"; Time$; "#", "start (async) request"
        
        .Refresh
      End With
    End With
  End With
  
  Debug.Print "#"; Time$; "#", "[END]"
  
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
24.07.2019 16:44:31 Jan
NotSolved
24.07.2019 17:48:31 Gast7777
NotSolved
25.07.2019 09:55:49 Gast56852
NotSolved
Blau Werte in der Excel Tabelle wiederholen sich
27.07.2019 14:32:06 Gast48456
NotSolved
25.07.2019 13:04:01 Torsten
NotSolved
26.07.2019 11:14:35 Jan
NotSolved
25.07.2019 13:15:17 Torsten
NotSolved