/ / Extraire / Copier les données sélectionnées du tableau HTML (web) et supprimer les colonnes indésirables - Excel VBA - excel, vba, excel-vba

Extraction / copie de données sélectionnées de la table HTML (Web) et suppression des colonnes non désirées - Excel VBA - excel, vba, excel-vba

Je "essaie de créer une macro qui va extraire / copier des données à partir du tableau HTML (Web) pour Excel et la suppression de certaines colonnes et la copie des données spécifiques à partir du tableau HTML copié Le processus sera.

  1. Mettez en surbrillance l'ensemble du tableau HTML puis copiez.
  2. Cliquez sur le bouton pour coller dans Excel. (l'ordre de collage doit être basé sur la lettre au-dessus de chaque colonne)

S'il vous plaît, aidez-moi car je suis nouveau sur VBA.

Ce serait le format dans Excel;

-              a               b              c               d

exceller

Bien qu'il s'agisse du HTML déposé (exemple uniquement). Le tableau HTML a 10 lignes par page, la colonne date contient également du texte, mais je n'ai besoin que de la date et de l'heure - en quelque sorte, il n'a besoin que de filtrer les données "aaaa-mm-jj hh: mm: ss".

-          a       c       -       -       -       -       -       b      -        d

entrer la description de l'image ici

J'ai ici un exemple de code:

Sub Paste()

Application.ScreenUpdating = False

Range("XEY1").Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False

y = 4
While Not Range("A" & y) = ""
y = y + 1
Wend

d = Range("XEY3")
Range("A" & y) = Replace(Mid(d, InStr(d, "(") + 5, InStr(d, ")") - InStr(d, "(") - 5), " CET", "")
Range("F" & y) = Range("XEY11")
Range("G" & y) = Range("XEY18")


ActiveSheet.Range("XEY1:XEY50").Clear

Application.ScreenUpdating = True
End Sub

Merci d'avance.

Réponses:

0 pour la réponse № 1

J'ai pu découvrir comment cela se produirait.

Code:

Option Explicit
Sub Button11_Click()
Application.ScreenUpdating = False
Dim j As Integer, b As Integer, r As Integer, g As String

Range("XET1").Select
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
False, NoHTMLFormatting:=True

j = 6
b = 1

For r = 5 To 1000
If ActiveSheet.Cells(r, 5).Value <> "" Then

Range("C" & j).Value = Range("XEU" & b).Value
g = Range("XEV" & b)
Range("E" & j).Value = Replace(Mid(g, InStr(g, "(") + 5, InStr(g, ")") - InStr(g, "(") - 5), "CEST", "")
Range("D" & j).Value = Replace(Mid(g, InStr(g, "") + 38, InStr(g, ")") - InStr(g, "(") + 25), "REQ", "")
Range("F" & j).Value = Range("XFD" & b).Value

j = j + 1
b = b + 1
End If
Next r

ActiveSheet.Range("XET1:XFD50").Clear
Application.ScreenUpdating = True
End Sub