シート画面
A列に「済」マークが入力されています。
下記のVBAコードに変更してください。
'作成開始ボタンをクリック
Private Sub CommandButton1_Click()
Dim lcoun As Long
Dim lCol As Long
Dim lNowRow As Long
If TextBox1 = "" Then
MsgBox "作成するサイトアドレスを入力してください。"
TextBox1.Activate
Exit Sub
End If
'マウスポインターを砂時計に
Application.Cursor = xlWait
If ExCreateIEobject Then
Range("A8:C65536").ClearContents
lCol = 2
lNowRow = 8
Cells(lNowRow, lCol) = LCase(TextBox1)
Cells(lNowRow, lCol + 1) = tIEobj.document.Title
lcoun = ExGetLink(LCase(TextBox1), lNowRow, lCol)
If lcoun > 0 Then
lNowRow = lNowRow + 1
While Cells(lNowRow, 2) <> "" And lNowRow < 20
If ExNavigateIEobject(Cells(lNowRow, lCol)) Then
Cells(lNowRow, lCol + 1) = tIEobj.document.Title
lcoun = ExGetLink(Cells(lNowRow, lCol), lMaxRow, lCol)
Cells(lNowRow, lCol - 1) = "済"
End If
lNowRow = lNowRow + 1
Wend
End If
End If
tIEobj.Visible = True
End Sub