VBA：アレイセル参照の不一致エラー

Question

は3/30

を更新しましたので、私は、コードを調整し、それが今でエラーフリー動作しますが、問題はそれが正しいデータを取得しないことです。 Xは基本的にcell（X、1）で始まり、そこから始まります。配列内の選択されたリストボックスオプションにXをリンクするにはどうすればよいですか？

OLDメッセージ： 私は国の複数選択し、その特定の国についても質問することができますユーザーフォームを持っています。これらはそれぞれarrCountries & arrQuestionに格納されています。これは、CIA World FactbookサイトからWeb Query Importを呼び出すメインサブにフィードします。私は、リストボックスのから配列を充填していたときに、それだけで追加されたので、それはある推測していた場合は

：私は、しかし、私は周りを取得する方法を整理することができないよう不一致エラーを得続けます文字列が存在するセル参照ではなく（まったく間違っています）。

私のワークシートには、国と呼ばれる開始時に1枚しかありません。列AはURL、列Bは国名です。私はDefined Public arrCountry（）、Public arrQuestion（）、Public Xをvariantとして定義しています。ここ

コード：

ユーザーフォームコード大丈夫クリックしてください：

'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 

メッセージボックスはとても正しく選択リストボックスのアイテムを返す私は、彼らが正しく保存されている知っています。だから私は、ループカウンタを追加

：再び

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 

、今そのループが動作し、インポートします

更新されたコード：

WebQueryコードIは、上のエラーを取得していますリストボックスやarrCountriesで何が選択されていても常にA1から始まります。

すべての考え/援助は素晴らしいだろう！

Answer 1

はそれを手に入れた：私は、配列内の値は、シート内のセルの値に一致したかどうかを確認し、その後に適切なセルを返すためにカウンタとIF文で追加する必要が

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 

インポート。