通过vba脚本改变网站上的下拉值
目前试图通过使用VBAmacros在网站上的下拉菜单中select不同的值。 我不相信索引方法会起作用（这里的大部分类似问题已经被回答了），因为下拉选项的顺序将会改变。 HTML代码如下，我试图select其中的一个选项（不要紧，哪一个，只需要基于“值”）。 谢谢你的帮助！
<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
我清理了代码。 基本上我删除了未使用的variables，并合并了几行。 根据所提供的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