- 締切済み
１つのPCで同じマクロを複数動かす
下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロで、いろんなURLを調べる作業があります。 その作業を早く完了させるために、下記のマクロを同時に動かそうと思っています。 しかし、エクセルを使えるPCが１つしかありません。 エクセルを２つ起動して、調べるURLを分けて、 ２つのエクセルでマクロを同時に動かす。 これをやろうと思いましたが、かなりPCが重くなるし、 エクセルが度々フリーズしたみたいになります。 どうにか、１つのPCで下記のマクロを複数動かして、 いろんなURLを調べる作業を、早くに完了する方法はありますでしょうか？ エクセル2016です。 よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub
- mute_low
- お礼率2% (59/2230)
- Visual Basic
- 回答数9
- ありがとう数3
- みんなの回答 （9）
- 専門家の回答
みんなの回答
- superside0
- ベストアンサー率64% (461/711)
> 『-2147012894』というエラー？が出る エラー発生時の割り込み処理として On Error GoTo ErrHandler としていて、その飛び先では ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If でエラー番号を書き出してから、次のループに行くプログラムになっているので -2147012894 というエラー番号のエラーが起きているのでしょう。 Cells(i, 2).Value = Err.Number を Cells(i, 2).Value = Err.Number & & ":" & Err.Description に書き換えれば エラー番号と エラー内容も表示されるでしょうから 原因がもう少し分かるかもしれません。 > そして、マクロが止まって、マクロを起動しなおす必要があります。 > マクロを起動し直すと、-2147012894の後４つくらいが空白にもなります。 ５つ同時に並列処理のうちうち１つが外部エラーすると、 それのエラーで割り込みされますが 他の４つもそのエラー処理に巻き込まれる形にになっているのでしょう。
- superside0
- ベストアンサー率64% (461/711)
>調べたいURLは、htmlサイトの他にWordPressサイトもあります。 >これら全てのサイトの形態は、SSL化されてるかどうかをヘッダでわかるのでしょうか？ ちなみに、ヘッダというのは、HTML内ので<head>～</head>のことでなく Webサーバーが返す httpヘッダのことです。 そして、"GET"だとhttpヘッダとコンテンツの両方を返しますが "HEAD"だとhttpヘッダのみ返しますです。 そしてWebサーバー側で httpからhttpsにリダイレクトする形で SSL正規化をしていれば WordPressであっても、コンテンツの中身に関係なく このhttpヘッダ情報のみで分かります。 （元々のコーディングもコンテンツは見ておらず ヘッダ情報しか参照されてませんし） ただし、 httpからhttpsにリダイレクトしてなくて HTML内でcanonical定義しているだけ （つまりgoogle等の検索エンジンのインデッスクのみSSLに正規化してるだけ） を行ってるコンテンツだと httpヘッダからは分かりません。 しかしこの場合"GET"しただけでは分からないのは同じことなので、 差はないことになります。 （まぁ、こういうのはきちんとSSL正規化できてる訳ではないので 除外してもよいでしょうし） > また、１０個同時に確認できるようにするには、 > どのような記述を足すとできるでしょうか？ すでに、.openを非同期にしてから ５個分を並列化したプログラムに修正したのですよね？ それを５回から10回に増やすだけですよ。 もちろん、ベタ書きにしてないで 配列とループを使ったコーディングにしたほうが、 シンプルで分かりやすいコードになるでしょうけど。
お礼
URLを５つ同時に調べる＆GETをHEADに変更したマクロを使っていたのですが、 『-2147012894』というエラー？が出ると、そこで結構長い間フリーズしたようになります。 そして、マクロが止まって、マクロを起動しなおす必要があります。 マクロを起動し直すと、-2147012894の後４つくらいが空白にもなります。 調べたいURLの羅列の中には、『-2147012894』が多くて、 その度に止まっていては、なかなか作業が進まないです。 この止まる現象などを避けて、スムーズに進めるようになるには、 どのような記述にすればできますでしょうか？ よろしくお願いいたします。
補足
とても詳しくありがとうございます！
- superside0
- ベストアンサー率64% (461/711)
非同期にして、１つのマクロ内で並列化するというのは良いアイデアですね。 さらに objHttp0.Open "GET", ～ のとこを objHttp0.Open "HEAD", ～ に変更して、データ転送量を減らすことで高速化できませんか？ (httpsに正規化されてるかは、ヘッダだけでわかるので） 実験してみましたが、 ネット環境次第ですが、私の環境だと、10個のURLを確認するに 5.2秒だったのが、1.9秒となり半分以下に短縮できましたよ。
補足
superside0さん、回答ありがとうございます。 objHttp0.Open "HEAD", ～ に変更したところ、少し早くなったようです。 ただ、一つ思ったのが、 これは、全てのサイトの形態に合うだろうかということです。 調べたいURLは、htmlサイトの他にWordPressサイトもあります。 これら全てのサイトの形態は、SSL化されてるかどうかをヘッダでわかるのでしょうか？ また、１０個同時に確認できるようにするには、 どのような記述を足すとできるでしょうか？ よろしくお願いいたします。
Cells(i + 1, 4).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL0 = "" strURL1 = "" strURL2 = "" strURL3 = "" strURL4 = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub
If strURL0 Like "http*" Then With objHttp0 If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL0, 1, InStr(strURL0, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If If strURL1 Like "http*" Then With objHttp1 If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL1, 1, InStr(strURL1, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i + 1, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i + 1, 2).Value = "non SSL" Else Cells(i + 1, 2).Value = "https" End If End If Else Cells(i + 1, 2).Value = "Err:" & .Status End If End With End If If strURL2 Like "http*" Then With objHttp2 If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL2, 1, InStr(strURL2, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i + 2, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i + 2, 2).Value = "non SSL" Else Cells(i + 2, 2).Value = "https" End If End If Else Cells(i + 2, 2).Value = "Err:" & .Status End If End With End If If strURL3 Like "http*" Then With objHttp3 If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL3, 1, InStr(strURL3, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i + 31, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i + 3, 2).Value = "non SSL" Else Cells(i + 3, 2).Value = "https" End If End If Else Cells(i + 3, 2).Value = "Err:" & .Status End If End With End If If strURL4 Like "http*" Then With objHttp4 If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL4, 1, InStr(strURL4, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i + 4, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i + 4, 2).Value = "non SSL" Else Cells(i + 4, 2).Value = "https" End If End If Else
Option Explicit Sub SSL() Dim objHttp0, objHttp1, objHttp2, objHttp3, objHttp4 As Object Dim nURL As String Dim strURL0, strURL1, strURL2, strURL3, strURL4 As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp0 = CreateObject("WinHttp.WinHttpRequest.5.1") Set objHttp1 = CreateObject("WinHttp.WinHttpRequest.5.1") Set objHttp2 = CreateObject("WinHttp.WinHttpRequest.5.1") Set objHttp3 = CreateObject("WinHttp.WinHttpRequest.5.1") Set objHttp4 = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow Step 5 strURL0 = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL0 = Replace(strURL0, "https:", "http:") strURL1 = LCase(Trim(Cells(i + 1, 1).Value)) 'A列の登録URL strURL1 = Replace(strURL1, "https:", "http:") strURL2 = LCase(Trim(Cells(i + 2, 1).Value)) 'A列の登録URL strURL2 = Replace(strURL2, "https:", "http:") strURL3 = LCase(Trim(Cells(i + 3, 1).Value)) 'A列の登録URL strURL3 = Replace(strURL3, "https:", "http:") strURL4 = LCase(Trim(Cells(i + 4, 1).Value)) 'A列の登録URL strURL4 = Replace(strURL4, "https:", "http:") If strURL0 Like "http*" Then objHttp0.Open "GET", strURL0, True objHttp0.send End If If strURL1 Like "http*" Then objHttp1.Open "GET", strURL1, True objHttp1.send End If If strURL2 Like "http*" Then objHttp2.Open "GET", strURL2, True objHttp2.send End If If strURL3 Like "http*" Then objHttp3.Open "GET", strURL3, True objHttp3.send End If If strURL4 Like "http*" Then objHttp4.Open "GET", strURL4, True objHttp4.send End If objHttp0.WaitForResponse objHttp1.WaitForResponse objHttp2.WaitForResponse objHttp3.WaitForResponse objHttp4.WaitForResponse 続く・・・
補足
URLを５つ同時に調べる＆GETをHEADに変更したマクロを使っていたのですが、 『-2147012894』というエラー？が出ると、そこで結構長い間フリーズしたようになります。 そして、マクロが止まって、マクロを起動しなおす必要があります。 マクロを起動し直すと、-2147012894の後４つくらいが空白にもなります。 調べたいURLの羅列の中には、『-2147012894』が多くて、 その度に止まっていては、なかなか作業が進まないです。 この止まる現象などを避けて、スムーズに進めるようになるには、 どのような記述にすればできますでしょうか？ よろしくお願いいたします。
私も似たようなVBAを運用していますが複数同時になめらかに動きません。というか数年前の開発時はVBA付きのEXCELが開いていると第二のEXCELを開くことさえできませんでしたが、今試すとファイル名を変えた同じVBAが曲りなりにもスタートできたので驚きました。同時に処理はされないようですが。 webの反応が遅いのでマルチタスクで処理を早くしたいという欲求は私も同じで、ひとつのVBAの中で複数のurlをopenして、複数のwebサイトの反応を同時に待つのが安くて手っ取り早いです。 objHttp.openの最後に,Trueを追加して非同期にする。 objHttp.sendの後で、.statusを待つループを追加する。 とすれば同じ動作でsendがwebページの応答を待たず次の行を実行するので、そのあとで複数のページを同時にopen、sendして、複数のstatusを待てるように改造出来ます。マルチタスクっぽく作るのは考え方が難しいので諦めて、5ページずつとか固定的にやれば簡単かもしれません。 .Statusは200を待つだけでいいんですかね？ 私のVBAを見ると.busy=TrueまたはreadyState<READYSTATE_COMPLETEの間待っているようです。昔、猿真似で作ったので忘れました。
補足
xitianさん、 マクロをありがとうございます。 ５ページずつ進めていくマクロで、１００個を１分近く時短させることができました！ どうも、ありがとうございます。 > .Statusは200を待つだけでいいんですかね？ 私のVBAを見ると.busy=TrueまたはreadyState<READYSTATE_COMPLETEの間待っているようです。昔、猿真似で作ったので忘れました。 このマクロ自体が、かなり前に書いてもらったもので、 私自身はマクロについて、ほとんどわからないんですね。 『.Statusは200を待つ』のでは、不都合があるでしょうか？ どの部分をどのように変えたら、さらに良いマクロになりますか？ よろしくお願いいたします。
- bardfish
- ベストアンサー率28% (5029/17766)
>どうにか、１つのPCで下記のマクロを複数動かして、 >いろんなURLを調べる作業を、早くに完了する方法はありますでしょうか？ 一応あります。 お金をかけて高スペックPCを導入すること。 CPUはマルチコア、マルチスレッドを選びRAMは可能な限り最大限搭載しOSの起動ストレージは高速なSSDにする。 CPUは今ならCore i9もしくはXeonの中堅以上を使用した方がいいでしょう。 もしくは、C++等で新規スレッドでExcelのプロセスを起動して実行させるという方法もありますが、こちらは高スペックPCじゃないと効果は薄いかもしれません。最低でもExcelを複数起動しても余裕なくらいRAMが必要。 ということで、普通のスペックのPCではExcelを複数起動してもしより速度単位祝にはなりません。 Excel VBAはマルチスレッドに対応していないと考えてください。Bookを異なるウィンドウで複数実行していたとしてもVBAのスレッドは実は人しかないんだとしたら逆に処理時間は増えるでしょう。 だとしたら、実行速度が遅いVBAよりもCisualBasicを使用した方が処理速度改善には有効かと思います。
- chie65536（@chie65535）
- ベストアンサー率44% (8742/19841)
＞下記のマクロを同時に動かそうと思っています。 １台のPCしか無い場合、同時に複数を動作させるより、１つづつ順に実行した方が早いです。 １台のPCで２つ同時に動かしても、計算するCPUは１つなので、１つだけの場合の２倍を超える時間が掛かります（同時実行すると、タスク管理やメモリ管理に要する余計な時間が必要になり、実行に必要な時間は２倍を超える長さになります） 例えば、１つに５秒掛かっている時、同時に２つ実行すると、５×２＋αで、１１秒とか１２秒とかの時間が掛かります。 つまり、１つづつ、順に実行する（１つが終わってから、次の１つを実行する）のが、最も早く終わるのです。 実行時間を半分にしたいなら、PCを２台使う必要があります。１／３にしたいなら、PCを３台使う必要があります。
補足
superside0さん、返信ありがとうございます！ ざっとやってみたところ、 "-2147012889:サーバー名またはアドレスは解決されませんでした " "-2147012894:処理がタイムアウトになりました " という表示がありました。 タイムアウトとかなので、 どちらにしても、止まってしまうのかもしれませんね。