Macro Excel - Tabela do site

Question

Ol&aacute;,

Galera eu estou montando uma planilha no excel para acompanhar a bolsa de valores do mercado estrangeiro.

Enfim a primeira parte &eacute; puxar as informa&ccedil;&otilde;es do site (sim tem v&aacute;rios tutorias na internet), a quest&atilde;o que quando eu atualizo ele varia o local onde sai o resultado, dessa forma eu n&atilde;o consigo copiar para um outro campo.

Este &eacute; o site no qual estou querendo pegar as informa&ccedil;&otilde;es:

https://www.marketwatch.com/investing/stock/ibm

Estas s&atilde;o as informa&ccedil;&otilde;es que eu preciso:

https://www.hardware.com.br/static/c/m/4b6fedce8858a4b0f8d3216020fbb914

Se algu&eacute;m souber uma forma de eu pegar s&oacute; essas 16 informa&ccedil;&otilde;es sem pegar o &ldquo;lixo&rdquo; do site eu agrade&ccedil;o

Answer

Movido da sala de Papo Aberto.

Bereja Scos

Modera&ccedil;&atilde;o do F&oacute;rum Hardware.com.br

Answer

Importe os dados para uma aba tempor&aacute;ria em seguida fa&ccedil;a um find para encontrar o que deseja

https://www.hardware.com.br/static/c/m/16af61807a5ba8721f6a7c0b92541bc7

Exemplo:

[code=vb]
Sub Importar_Gdow()
    Dim rng As Range
    Dim arrMarket As Variant
 
    arrMarket = Array(Dow, S&P 500, Nasdaq, GlobalDow, Gold, Oil)
 
    With Plan2
        .Activate
        .Cells.Clear
    End With

With ActiveSheet.QueryTables.Add(Connection:= _
        URL;http://www.marketwatch.com/investing/index/gdow, _
        Destination:=Range(A1))
        .Name = Balanco-Plan1
        .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

With Plan1
        .Range(A1:D6).ClearContents

For i = LBound(arrMarket) To UBound(arrMarket)

Set rng = Plan2.Cells.Find(arrMarket(i))
            If Not rng Is Nothing Then
                For j = 0 To 3
                    .Cells(i + 1, j + 1).Value = rng.Offset(, j)
                Next j
            End If
         
        Next i
    End With
End Sub

[/code]

Ferramentas

Mover Tópico