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

Question

更新 3/30

所以我调整了代码，它现在运行没有错误，但问题是它没有提取正确的数据。 X 基本上从 cell(X,1) 开始，然后从那里继续。我如何 link X 到数组中的 selected 列表框选项？

旧消息： 我有一个用户表单，允许多个 select 个国家/地区以及有关该特定国家/地区的问题。它们分别存储在 arrCountries 和 arrQuestion 中。然后将其提供给我的主子，它要求从 CIA World Factbook 站点进行 Web 查询导入。然而，我一直收到不匹配错误，我似乎无法弄清楚如何解决：

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

我的工作sheet 在开始时只有 1 个 sheet 称为国家，A 列是 URL，B 列是国家名称。我已将 Public arrCountry()、Public arrQuestion() 和 Public X 定义为变量。

代码在这里：

点击确定时的用户表单代码：

'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

消息框 return 正确 selected 列表框项目，所以我知道它们存储正确。

我收到错误的 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"))
            .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

中 select 编辑了什么，它总是以 A1 开头

任何 thoughts/assistance 都很棒！

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"))
                .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 语句来检查数组中的值是否与 sheet 中的单元格值匹配，然后 return 用于导入的适当单元格.

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

VBA: Array cell reference Mismatch error

vba

excel

excel-web-query