• ベストアンサー
  • 困ってます

エクセルでマクロの進行状況を表示あるには

  • 質問No.5620553
  • 閲覧数277
  • ありがとう数2
  • 回答数1

お礼率 100% (18/18)

下記のマクロはURLからタイトルを抽出するものなのですが
件数が何千件とあり、進行状況が分かれば便利かなと思います。
表示方法はどのような形でも構わないのですが、ご教授願います。

色々調べたのですがうまくいかず困っております。

ちなみに私は全くの度素人であり、マクロもネット上で検索して
見つけたものをそのまま使用しております。

-------------------------------
Private Sub CommandButton1_Click()
Dim url As Range
Dim Http, buf As String

Set Http = CreateObject("MSXML2.XMLHTTP")
Set url = Range("A2")
Do While (url.Value <> "")
Http.Open "GET", url.Value, False
Http.Send
With CreateObject("ADODB.Stream")
.Open
.Type = 2 'adTypeText
.Charset = "unicode"
.Writetext Http.ResponseBody
.Position = 0
.Charset = "utf-8"
buf = .ReadText()
.Close
End With
'msgbox buf
url.Offset(0, 1).Value = getTitle(buf)
Set url = url.Offset(1, 0)
Loop
Set Http = Nothing
End Sub

Private Function getTitle(buf As String) As String
Dim pos1 As Long, pos2 As Long

pos1 = InStr(1, buf, "<title>")
If pos1 = 0 Then
pos1 = InStr(1, buf, "<TITLE>")
If pos1 = 0 Then
getTitle = ""
Exit Function
Else
pos2 = InStr(pos1 + 7, buf, "</TITLE>")
End If
Else
pos2 = InStr(pos1 + 7, buf, "</title>")
End If
getTitle = Mid(buf, pos1 + 7, pos2 - pos1 - 7)
End Function

Private Sub タイトル抽出_Click()

End Sub
------------------------------

宜しくお願い致します。

質問者が選んだベストアンサー

  • 回答No.1
  • ベストアンサー

ベストアンサー率 61% (656/1071)

> 色々調べたのですがうまくいかず困っております。

回答者にとっても、どの程度「色々調べた」のか、何がうまくいかないのかが全くわからず、回答に困っていることと思います。
調査に数日ぐらい費やしているのでしょうか?

進捗状況を逐次得るためにはループ処理の中で 1件処理する度にカウンターを更新して、表示を更新するのが基本だと思う。
これは質問者さんもすぐにイメージできていると思う。
すなわちカウントアップ (または進捗率の再計算) と再表示はループ処理の中で行う。

単なるカウントアップの場合は Long 型の変数が 1ずつ増えていけば良いだけ。
進捗率なら全体で何件あるのかを調べておく。

質問者さんがいろいろと調べた範囲とダブっていなければ良いのだが。
http://oshiete.goo.ne.jp/search_goo/?status=select&MT=%BF%CA%C4%BD&nsMT=&ct_select=1&ct0=205&ct1=221&ct2=257
http://www.google.com/search?hl=ja&lr=lang_ja&ie=UTF-8&oe=UTF-8&q=vba+%E9%80%B2%E6%8D%97&num=50
お礼コメント
nao7777

お礼率 100% (18/18)

ご回答ありがとうございます。

教えて頂いたサイトを参考にもう少し自分なりに頑張ってみたいと思います。
投稿日時:2010/01/27 14:03
関連するQ&A

その他の関連するQ&Aをキーワードで探す

ピックアップ

ページ先頭へ