データのある所まで指定したい(2) 文字検索の追加

質問

E列に結果を表示させますが、それぞれの結果のEセル（左上）に「問題」という文字があればそのまま実行し、
なければ元アドレスであるB列でMsgBox（k &　”行目は間違っています”）と表示させたい。
お願い致します。

Dim y(80) As String
Dim cp(80) As String
Dim i As Integer

e = 70
For i = 3 To Range("B65536").End(xlUp).Row

y(i) = Range("B" & i).Value
cp(i) = Range("P" & i).Value
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & y(i), Destination:=Range("E" & e + 1))
.Name = "000"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "" & cp(i)
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
e = Range("E65536").End(xlUp).Row
Next i

回答No.2

kmetu · ベストアンサー

End With
If (Range("E" & e+1).Value Like "*問題*") = False Then
Range("B" & i).Select
MsgBox (i & "行目は間違っています")
Exit Sub 'ここで終了します。終了しない場合は不要です。
End If
e = Range("E65536").End(xlUp).Row

こんな感じになると思います。
Range("E" & e+1).は実際に動作を見て位置を変更してください。
私がテストしてる環境ではデータが入っていないので
結果が表示されませんから具体的な位置は分かりません。

お礼

お手数お掛け致しました。
動作位置は変更せず実行できました。

有難う御座います。

回答No.1

kmetu

> 結果のEセル（左上）

これがどこをさすのか分かりませんが
E列に問題と言う文字があるとした場合、イメージとしては

If (Range("E" & i).Value Like "*問題*") = False Then
Range("B" & i).Select
MsgBox (k & "行目は間違っています")
'kがどこから出てきたのかは分かりませんが…
End If

になるでしょう。

お礼

お世話になります。

例えば結果が(E71:F78),(E79:F82),(E83:F88)とした場合、Eセル左上の「問題」文字がある場所はE71、E79、E83を指します。
また、変数kとしたのは勝手に作ったもので変数iとして使用できればそれで結構です。

作って頂いた追加分をどこに入れたら良いか教えて下さい。