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.
- Mettez en surbrillance l'ensemble du tableau HTML puis copiez.
- 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
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
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 № 1J'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