Question

更新3/30

所以我调整了代码并且它现在没有运行错误，但问题是它没有提取正确的数据。 X基本上从单元格（X，1）开始并从那里继续。如何将X链接到阵列中选定的列表框选项？

旧消息： 我有一个userform，允许多选国家，也有关于该特定国家的问题。这些存储在arrCountries＆amp;分别是arrQuestion。然后将其提供给我的主要子，该子要求从CIA World Factbook网站进行Web查询导入。但我仍然遇到一个不匹配的错误，我似乎无法解决如何解决问题：

如果我不得不猜测是因为当我从列表框中填充数组时，它只是添加一个字符串而不是字符串所在的单元格引用（或者我完全错了）。 / p>

我的工作表在启动时只有一张名为“国家/地区”，而列A是URL，而列B是国家/地区名称。我已将Defined Public arrCountry（），Public arrQuestion（）和Public X作为变体。

代码在这里：

单击“确认”时的Userform代码：

'Handles when the user clicks okay
Private Sub cbOkay_Click()
    'Me.Hide
'Capture ticker selection(s) from list box.
Dim cI As Long
Dim cX As Long
Dim qI As Long
Dim qX As Long

'Stores the Countries selected into an array
If lbCountries.ListIndex <> -1 Then
    For cI = 0 To lbCountries.ListCount - 1
        If lbCountries.Selected(cI) Then
            ReDim Preserve arrCountry(cX)
            arrCountry(cX) = lbCountries.List(cI)
            cX = cX + 1
        End If
    Next cI
End If

If cX = 0 Then MsgBox "Please select at least one country to analyse."
'MsgBox Join(arrCountry, vbCrLf)

'Stores the Questions selected into an array
If lbQuestions.ListIndex <> -1 Then
    For qI = 0 To lbQuestions.ListCount - 1
        If lbQuestions.Selected(qI) Then
            ReDim Preserve arrQuestion(qX)
            arrQuestion(qX) = lbQuestions.List(qI)
            qX = qX + 1
        End If
    Next qI
End If

If qX = 0 Then MsgBox "Please select at least one question to analyse."

'MsgBox Join(arrQuestion, vbCrLf)

'Unload the form
Unload Me

cancel = False
End Sub

消息框会返回正确选择的列表框项目，因此我知道它们存储正确。

WebQuery代码我收到错误：

更新后的代码：

所以我添加了一个循环计数器：

Sub webQueryimport(arrCountry())

Dim mystr As String
Dim X As Integer
Dim selected As Variant

For Each selected In arrCountry
    X = X + 1
Worksheets("Countries").Select
Worksheets("Countries").Activate
     mystr = Cells(X, 1)
     Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = selected

        With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$1"))
            .WebSelectionType = xlEntirePage 'this tells VBA what to select and import
            .WebFormatting = xlWebFormattingNone 'this turns off web formatting, otherwise text is various sizes
            .Refresh BackgroundQuery:=False 'if commented out, doesn't add any data
        End With
Next selected

End Sub

同样，现在循环工作并将导入，但无论在列表框和arrCountries中选择什么，它总是从A1开始

任何想法/帮助都会很棒！

Answer 1

知道了：

Sub webQueryimport(arrCountry())

Dim mystr As String
Dim X As Integer
Dim rng As Range
Dim selected As Variant

Set rng = Range("B1")

For Each selected In arrCountry()
    For X = 1 To 5 'rng.Offset(0, 0).End(xlDown).Rows.count
        Worksheets("Countries").Select
        Worksheets("Countries").Activate

        If Cells(X, 2).Value = selected Then
            mystr = Cells(X, 1).Value
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = selected

            With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$1"))
                .WebSelectionType = xlEntirePage 'this tells VBA what to select and import
                .WebFormatting = xlWebFormattingNone 'this turns off web formatting, otherwise text is various sizes
                .Refresh BackgroundQuery:=False 'if commented out, doesn't add any data
            End With
        End If
      Next X
    Next selected
End Sub

我需要添加一个计数器和IF语句来检查数组中的值是否与工作表中的单元格值匹配，然后返回相应的单元格以进行导入。

VBA：数组单元格引用不匹配错误

1 个答案: