![](/img/trans.png)
[英]Open an Excel file with MS Access VBA and move the data from one sheet to another sheet
[英]Import data from different webpages in one in MS Excel sheet using VBA
我在MS Excel中使用VBA代碼從三個不同的網頁導入一些數據。 目前,我能夠為每個網頁在單獨的Excel工作表中導入數據,然后使用另一個VBA將它們進一步合並到一個工作表中。 VBA代碼如下:
Sub GetTable()
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
'create a new instance of ie
Set ieApp = New InternetExplorer
'you don’t need this, but it’s good for debugging
ieApp.Visible = True
'assume we’re not logged in and just go directly to the login page
ieApp.Navigate "http://cms.indianrail.gov.in/CMSREPORT/JSP/rpt/LoginAction.do?hmode=loginPage"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.Document
'fill in the login form – View Source from your browser to get the control names
With ieDoc
.getElementById("userId").setAttribute "value", "rlbdgs"
.getElementById("userPassword").setAttribute "value", "123"
'~~> This will select the 2nd radio button as it is `0` based
.getElementsByName("userType")(1).Checked = True
.getElementById("hmode").Click
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'now that we’re in, go to the page we want
ieApp.Navigate "http://cms.indianrail.gov.in/CMSREPORT/JSP/rpt/GeneralReportAction.do?hmode=drillDown25And26And30GeneralReport&kioskOrManual=K&val=26&wherePart=ZONE_CODE_C=-IR-&lobby=BSL&type=B&startDate=&endDate=&traction=ELEC"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'get the table based on the table’s id
Set ieDoc = ieApp.Document
Set ieTable = ieDoc.all.Item("report-table")
'copy the tables html to the clipboard and paste to the sheet
If Not ieTable Is Nothing Then
oHTML = ""
For i = 0 To ieTable.Length - 1
oHTML = oHTML & ieTable.Item(i).outerHTML
Next i
Set clip = New DataObject
clip.SetText "<html>" & oHTML & "</html>"
clip.PutInClipboard
Sheet1.Select
Sheet1.Range("A1").Select
Sheet1.PasteSpecial "Unicode Text"
End If
'now that we’re in, go to the page we want
ieApp.Navigate "http://cms.indianrail.gov.in/CMSREPORT/JSP/rpt/GeneralReportAction.do?hmode=drillDown25And26And30GeneralReport&kioskOrManual=K&val=26&wherePart=ZONE_CODE_C=-IR-&lobby=AQ&type=B&startDate=&endDate=&traction=ELEC"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'get the table based on the table’s id
Set ieDoc = ieApp.Document
Set ieTable = ieDoc.all.Item("report-table")
'copy the tables html to the clipboard and paste to the sheet
If Not ieTable Is Nothing Then
oHTML = ""
For i = 0 To ieTable.Length - 1
oHTML = oHTML & ieTable.Item(i).outerHTML
Next i
Set clip = New DataObject
clip.SetText "<html>" & oHTML & "</html>"
clip.PutInClipboard
Sheet2.Select
Sheet2.Range("A1").Select
Sheet2.PasteSpecial "Unicode Text"
End If
'now that we’re in, go to the page we want
ieApp.Navigate "http://cms.indianrail.gov.in/CMSREPORT/JSP/rpt/GeneralReportAction.do?hmode=drillDown25And26And30GeneralReport&kioskOrManual=K&val=26&wherePart=ZONE_CODE_C=-IR-&lobby=KYN&type=B&startDate=&endDate=&traction=ELEC"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'get the table based on the table’s id
Set ieDoc = ieApp.Document
Set ieTable = ieDoc.all.Item("report-table")
'copy the tables html to the clipboard and paste to the sheet
If Not ieTable Is Nothing Then
oHTML = ""
For i = 0 To ieTable.Length - 1
oHTML = oHTML & ieTable.Item(i).outerHTML
Next i
Set clip = New DataObject
clip.SetText "<html>" & oHTML & "</html>"
clip.PutInClipboard
Sheet3.Select
Sheet3.Range("A1").Select
Sheet3.PasteSpecial "Unicode Text"
End If
'close 'er up
ieApp.Quit
Set ieApp = Nothing
'combine
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
是否可以修改VBA代碼,以便將每個網頁中的數據導入同一工作表中,而無需在導入后使用VBA合並工作表?
是。 在第一個if語句中,您具有Sheet1。 在第二個中,您具有Sheet2。 如果將第二個及以后的數據更改為Sheet1,則必須更改范圍,以使其不會覆蓋工作表中的第一個數據。 它可能看起來像這樣:
Sheet1.Select
Sheet1.Range("A1").Select
Sheet1.PasteSpecial "Unicode Text"
第二個可能看起來像這樣:
Sheet1.Select
Sheet1.Range("A200").Select
Sheet1.PasteSpecial "Unicode Text"
編輯:
在第一個if語句中嘗試以下操作:
Sheet1.Select
Sheet1.Range("A1").Select
Sheet1.PasteSpecial "Unicode Text"
Dim length As Integer
length = selection.rows.count
在第二個if語句中,嘗試以下操作:
Sheet1.Select
Sheet1.Range("A" & length + 1).Select
Sheet1.PasteSpecial "Unicode Text"
length = length + selection.rows.count
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.