Question

目前正尝试通过使用VBA宏在网站的下拉菜单中选择其他值。我不相信索引方法会起作用（这里的大多数类似问题都已经回答了），因为下拉列表中的选项顺序将会改变。 HTML代码如下，我正在尝试选择其中一个选项（无论哪一个，它只需要根据“值”特定于一个）。谢谢你的帮助！

    <select id="storePickupOptions" ng-model="selectedPickupStore" ng-options="storeDescription(pickupStore) for pickupStore in onlineShoppingStores track by pickupStore.recordId" ng-required="true" mobile-friendly-select-options="true" class="ng-valid ng-valid-required ng-touched ng-dirty ng-valid-parse" required="required"><option value="01600273" label="60 Worthington Mall, Worthington, OH 43085 (2.03 miles)" selected="selected">60 Worthington Mall, Worthington, OH 43085 (2.03 miles)</option><option value="01600818" label="2090 Crown Plaza Dr., Columbus, OH 43235 (2.68 miles)">2090 Crown Plaza Dr., Columbus, OH 43235 (2.68 miles)</option>t Street, Troy, OH 45373 (61.91 miles)">731 W. Market Street, Troy, OH 45373 (61.91 miles)</option></select>


<option value="01600273" label="60 Worthington Mall, Worthington, OH 43085 (2.03 miles)" selected="selected">60 Worthington Mall, Worthington, OH 43085 (2.03 miles)</option>
<option value="01600818" label="2090 Crown Plaza Dr., Columbus, OH 43235 (2.68 miles)">2090 Crown Plaza Dr., Columbus, OH 43235 (2.68 miles)</option>
<option value="01600805" label="6417 Columbus Pike, Lewis Center, OH 43035 (7.18 miles)">6417 Columbus Pike, Lewis Center, OH 43035 (7.18 miles)</option>

对于凌乱的代码感到抱歉，这是由于大量的修改试图让它工作，但VBA低于。

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = True

Dim rngURL As Range
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim MyURL As String
Dim Rows As Long, links As Variant, IE As InternetExplorer, link As Variant
Dim i As Long
Dim sID As String
Dim rngLinks As Range, rngLink As Range


Dim filterRange As Range
Dim copyRange As Range

Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Sheet1")

Set IE = New InternetExplorer

Rows = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
Set rngLinks = ws1.Range("E2:E" & Rows)
i = 2

With IE
    .Visible = True


        .navigate ("https://www.kroger.com/account/update")

        While .Busy Or .readyState <> 4: DoEvents: Wend
        Application.Wait (Now() + TimeValue("00:00:006"))

                Dim doc As Object
                Set doc = IE.document


            doc.getElementById("storePickupOptions").Value = "01600818"


End With





Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

ws1.Activate

Set rngLinks = Nothing

End Sub

Answer 1

我清理了代码。基本上我删除了没有使用的变量，并组合了几行。根据查看提供的HTML，这应该会更改下拉列表的值。

Option Explicit

Public Sub UpdateWeb()
    Dim ws1             As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Dim ie              As New InternetExplorer
    Dim rows            As Long: rows = ws1.Cells(ws1.rows.Count, "A").End(xlUp).Row
    Dim rngLinks        As Range: Set rngLinks = ws1.Range("E2:E" & rows)

    With ie
        .Visible = True
        .navigate ("https://www.kroger.com/account/update")
        While .Busy Or .readyState <> 4
            Application.Wait (Now() + TimeValue("00:00:01"))
        Wend
        'It appears this element is only available when you've logged in
        .document.getElementById("storePickupOptions").Value = "01600818"
    End With
End Sub

通过vba脚本更改网站下拉菜单的价值

1 个答案: