Question

我希望将下面的宏应用于数据表，并为每个数据进行计算。

示例：当用户输入单元格A1和A2时，宏将运行，并且   填充A3和A4。

A1：80292

A2：11234

A3 ：（以英里为单位的宏运行和返回距离）

A4 ：（宏观旅行费用和返还费用）

下面是我创建的宏-如何将其应用于我的需求？

Public Sub GetValue()
    Dim ie As Object
    Dim url As String
    Dim myPoints As String
    Dim appIE As InternetExplorerMedium
    Dim objElement As Object

Set appIE = New InternetExplorerMedium
sURL = "http://www.defensetravel.dod.mil/mobile/views/mileage/mileage.cfm"
With appIE
    .Navigate sURL
    .Visible = True
End With

Do While appIE.Busy Or appIE.ReadyState <> 4
    DoEvents
Loop

   appIE.Document.getElementById("from").Value = Range("A1")
   appIE.Document.getElementById("to").Value = Range("A2")
   appIE.Document.forms(0).submit

Do While appIE.Busy Or appIE.ReadyState <> 4
    DoEvents
    Loop

    Dim miles
Set miles = appIE.Document.getElementsByName("miles")(0)
Dim milesText
milesText = miles.Value

    Range("A3").Value = milesText

Dim cost
Set cost = appIE.Document.getElementsByName("milescost")(0)
Dim costText
costText = cost.Value

    Range("A4").Value = costText


Set appIE = Nothing

End Sub

Answer 1

在标准模块中，像这样更改代码

Public Sub GetValue(x As Range, y As Range)
Dim ie As Object
Dim sURL As String
Dim myPoints As String
Dim appIE As InternetExplorerMedium
Dim objElement As Object

Set appIE = New InternetExplorerMedium
sURL = "http://www.defensetravel.dod.mil/mobile/views/mileage/mileage.cfm"
With appIE
    .navigate sURL
    .Visible = True
End With

Do While appIE.Busy Or appIE.readyState <> 4: DoEvents: Loop

appIE.document.getElementById("from").Value = x
appIE.document.getElementById("to").Value = y
appIE.document.forms(0).submit

Do While appIE.Busy Or appIE.readyState <> 4: DoEvents: Loop

Dim miles
Set miles = appIE.document.getElementsByName("miles")(0)
Dim milesText
milesText = miles.Value

x.Offset(2).Value = milesText

Dim cost
Set cost = appIE.document.getElementsByName("milescost")(0)
Dim costText
costText = cost.Value

y.Offset(2).Value = costText
Set appIE = Nothing
End Sub

然后在工作表模块中尝试

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Or Target.Address = "$A$2" Then Call GetValue(Range("A1"), Range("A2"))
If Target.Address = "$B$1" Or Target.Address = "$B$2" Then Call GetValue(Range("B1"), Range("B2"))
End Sub

在工作表模块中尝试一下

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 1 Or Target.Row = 2 Then
    If Target.Column >= 1 And Target.Column <= 150 Then
        Call GetValue(Cells(1, Target.Column), Cells(2, Target.Column))
    End If
End If
End Sub

更改后运行VBA宏

1 个答案: