khaledo قام بنشر أبريل 11, 2019 قام بنشر أبريل 11, 2019 السلام عليكم ورحمة الله وبركاته إخواني الأفاضل أرجو المساعدة في الملف المرفق وتعديل أكوادي إن أمكن أريد استيراد معلومات من موقع xe.com عن مدة 3 شهور حسب ما هو موضح بالملف المرفق وشكراً Book0.xlsm
khaledo قام بنشر أبريل 13, 2019 الكاتب قام بنشر أبريل 13, 2019 (معدل) السلام عليكم ورحمة الله وبركاته لو تكرمتم اريد تجزئة المطلوب بمعنى اريد لصق الجدول المستورد في اول خلية فارغة في العمود A من فضلكم عدلوا الكود التالي Sub Extract_data() Dim URL As String, links_count As Integer Dim i As Integer, j As Integer, row As Integer Dim XMLHTTP As Object, html As Object Dim tr_coll As Object, tr As Object Dim td_coll As Object, td As Object Dim tbl As Object Dim td_col As Object links_count = 0 Dim LR0 As Long LR0 = Range("A" & Rows.Count).End(xlUp).row For i = 0 To links_count If Range("L1") <> "" And Range("Q1") <> "" Then URL = "https://www.xe.com/currencytables/?from=" & Range("Q1") & "&date=" & Format(Range("L1"), "yyyy-mm-dd") ' Date and currency are dynamic Set XMLHTTP = CreateObject("MSXML2.XMLHTTP") XMLHTTP.Open "GET", URL, False XMLHTTP.send Set html = CreateObject("htmlfile") html.body.innerHTML = XMLHTTP.responseText Set tbl = html.getElementsByTagName("Table") Set tr_coll = tbl(0).getElementsByTagName("TR") For Each tr In tr_coll j = 1 Set td_col = tr.getElementsByTagName("TD") For Each td In td_col Cells(row + 1, j).Value = td.innerText j = j + 1 Next row = row + 1 Next End If Next End Sub تم تعديل أغسطس 21, 2022 بواسطه jjafferr
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.