- ベストアンサー
エクセルでURLに特定文字が含まれるか調べる方法
DOUGLAS_の回答
- DOUGLAS_
- ベストアンサー率74% (397/534)
DOUGLAS_ です。 ＃これは、「回答No.7」の解説です。 ＃このスレッドを参考にされる方のために、事の経緯を記しておきます。 【１】先ず、使用するプログラムですが、ご質問文内の中のコードでは、「WinHttpRequest」を用いていました。 これが、お尋ねの「Unicode 文字のマッピング・・・」というエラーを返しましたので、代わりに、私の手許にあった資料から、「XMLHTTP」に替えてみると、お尋ねのエラーが発生しなくなりましたので、「回答No.4」のコード http://okwave.jp/qa/q8121305.html#answer_seq_no4 を提示した次第です。 【２】次に、「エクセルがフリーズ」という問題が発生しましたので、調べてみますと、 http://webos-goodies.jp/archives/50548720.html に -- ここから引用 --------------------------------------------------- XMLHttpRequest オブジェクトを再利用する際も、abort メソッドを呼び出す必要がある -- ここまで引用 --------------------------------------------------- と書かれておりましたので、【書き換え１】の代替策を提示しました。 しかし、「発行済みのリクエストを中止」しないから「エクセルがフリーズ」したと結び付ける根拠がありませんでしたので、念のために、【書き換え２】のコードを提示した次第です。 【３】ところが、と申しますか、案の定、「エクセルがフリーズ」するようですので、一から考え直してみることにしました。 ●●● ここからが本題ですが ●●● よくよく調べてみますと、 http://loafer.jp/mixi/diary/class.xsp?2006-07-20-22-26 に -- ここから引用 --------------------------------------------------- XMLHTTP は、・・・ 利用者が意図しないところで、Cookie や履歴の情報を使用してしまう危険がある ・・・ ServerXMLHTTP は、・・・ セキュリティ面で安全なように、Cookie やキャッシュなどの情報は一切共有しない。 -- ここまで引用 --------------------------------------------------- と書いてありましたので、「XMLHTTP」ではなくて、「ServerXMLHTTP」を使うことにしました（「ServerXMLHTTP」でも【１】のエラーは回避できています）。 実際に、それぞれでマクロを動かした後、インターネットキャッシュを掃除するフリーソフト（CCleaner）でクリーンアップしてみると、「XMLHTTP」は、キャッシュや Cookie が削除されましたが、「ServerXMLHTTP」は、削除すべきものが見出されませんでした。 つまり、「エクセルがフリーズ」するのは、「キャッシュや Cookie」が蓄積した結果なのではないかと憶測したわけですが、これもその因果関係を証明する根拠はありません。 しかし、「abort メソッド を加えたこと」・「ServerXMLHTTP に変更したこと」は、改悪ではなく、改善と思われますので、これはこれでよいかと存じます。 さらに、 http://support.microsoft.com/kb/237906/ja に -- ここから引用 --------------------------------------------------- XMLHTTP オブジェクトを使用して、他の Web サーバーにリクエストを送信する ・・・ と ・・・ さまざまな予期しない問題が発生する恐れがあります。 -- ここまで引用 --------------------------------------------------- と書かれていますので、当たらずとも遠からずかと思っております。 また、[Windows タスク マネージャ] から起動した [リソース モニタ] で確認してみると、ネットワークの送受信に関わる負担も「ServerXMLHTTP」の方が軽そうです（しかし、かなりの通信量ではありますが。。。ひょっとしたら、お使いのインターネット接続に関する通信速度等の関係でフリーズしているということもなきにしもあらずかも知れません）。 なお、同じく [リソース モニタ] で確認してみても、ＣＰＵ の使用率は大したことありませんし、また、メモリの消費量も余り変わりませんので、ＣＰＵやメモリが原因でフリーズしているようにはありません。 【４】次に、最初のご質問にありました ＞存在しないURLと「処理がタイムアウト」するURLは処理から除外したい という問題についてですが、「回答No.4」では、「存在しないURL」についは「スルー出来た」としながらも、「処理がタイムアウト」については、「よく分かりません」と逃げております。 実は、「XMLHTTP」には、#2さんがお書きの「WaitForResponse メソッド」のような装備がありませんでしたので、 ＞下記のコードをお試しになってから、不具合があれば、そのＵＲＬをお知らせください。 と書いた次第です。 今回は、「XMLHTTP」ではなくて、「ServerXMLHTTP」を使うことにしましたので、[waitForResponse メソッド] が装備されているのですが、 http://msdn.microsoft.com/en-us/library/ms754586(v=vs.85).aspx を見ると、「非同期操作が完了するまでの間、要求サーバーが実行を一時停止（私は、この意味がよく分かりません）」ということで、[Send メソッド] の後に指定するもののようです。 ところが、実際には、[Send メソッド] のところで時間が掛かっているようですので、むしろ、[Send メソッド] の前に、タイムアウト値を設置するようになっている（上記ＵＲＬ）[setTimeouts メソッド] の方がよいのではと考えました。 [setTimeouts メソッド] の構文は、 setTimeouts(resolveTimeout, connectTimeout, sendTimeout, receiveTimeout) となっていて、それぞれ、「ドメインネームを解決し、サーバーへの接続を確立し、データを送り、レスポンスを受け取るための」タイムアウトミリ秒（1000で１秒）のようです（デフォルトは、それぞれ、無制限、60秒、30秒、30秒）。 私の環境（Windows Vista Business 32ビット、Excel 2003、ＣＰＵ：1.83GHz×２、メモリ：３GB）でいろいろと試行した結果、<< 私の環境の場合では >> objHTTP.setTimeouts 4000, 500, 500, 3000 （それぞれ、４秒、0.5秒、0.5秒、３秒）で、ほとんどのＵＲＬがタイムアウトすることなく読み込めました。 というか、タイムアウトを設定するほどのこともないかと存じますので、何でしたら、 .setTimeouts 4000, 500, 500, 3000 の行は削除してください。 【５】さらに、エラーが発生した場合は、Ｂ列に、そのエラーの記述を吐き出すようにしましたので、ここをご覧ください。 以上により、Ｂ列に吐き出される文字列は、 １）「strKW」があった場合は「あり」 ２）なかった場合は「なし」 ３）「存在しないURL」の場合は「不正なＵＲＬ」 ４）「ServerXMLHTTP」のステータスが「200 = OK」・「404 = Not Found」以外の場合は、「問題あり」 ５）「この操作を完了するのに必要なデータは、まだ利用できません。」というエラーの場合は、「タイムアウト」 ６）その他のエラーの場合は、エラーの記述 になりますので、Ｂ列で並べ替えて（１～４）以外のセル（Ｂ列の値）を消して、また、マクロを実行すると、Ｂ列が空白の行のみ、再度、確認作業をするようにしております。 「タイムアウト」になっても、再度試行すると、正常に読み込む可能性は大きいです。
関連するQ&A
- エクセルのマクロについて
Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア～ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか？できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub
- 締切済み
- オフィス系ソフト
- エクセル マクロ 抽出
教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数＝値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- 特定の文字以外を入力すると別シートに表記する方法
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim StrRow As Long Dim TgtCol As Long Dim MaxRow As Long Dim ChgRow As Long Dim PutSh1 As Worksheet Dim PutSh2 As Worksheet Dim PutSh3 As Worksheet Dim PutCol As Long Dim PutRow As Long Dim ChgRng1 As Range Dim ChgRng2 As Range Dim ChgRng3 As Range StrRow = 5 MaxRow = 35 If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub Set PutSh1 = ThisWorkbook.Sheets("Sheet2") Set PutSh2 = ThisWorkbook.Sheets("Sheet3") Set PutSh3 = ThisWorkbook.Sheets("Sheet4") With ThisWorkbook.Sheets("Sheet1") Set ChgRng1 = Range(.Cells(StrRow, 3), .Cells(MaxRow, 3)) 'C列 Set ChgRng2 = Range(.Cells(StrRow, 5), .Cells(MaxRow, 5)) 'E列 Set ChgRng3 = Range(.Cells(StrRow, 7), .Cells(MaxRow, 7)) 'G列 End With ChgRow = Target.Row If Not Intersect(Target, ChgRng1) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh1, ChgRow, Target.Value End If If Not Intersect(Target, ChgRng2) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh2, ChgRow, Target.Value End If If Not Intersect(Target, ChgRng3) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh3, ChgRow, Target.Value End If End Sub 以前質問させて頂いた内容で追加の質問です。 Sheet1の指定したセルに「ー（ハイフン）」の文字がある時は、Sheet2〜4に転送（表記）しない方法を追加する場合はどの様にすれば宜しいでしょうか？
- ベストアンサー
- Excel（エクセル）
- ２つのVBAを組み合わせる方法
お世話になります、２つのVBAを組み合わせる方法で迷っています。 １つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 ２つめが Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。２つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか？
- ベストアンサー
- Excel（エクセル）
- 下記のマクロをもっと早くするには？
下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロを動かすと、大体３秒に１つのURLを調べるくらいの早さです。 もっと早く調べられるようにするには、どのような記述にすればできるでしょうか？ また、エクセルの他の設定で、マクロを早くできたりしますか？ よろしくお願いいたします。 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
- 締切済み
- Visual Basic
- エクセルマクロ 特定の文字列を含む行のみを残す （マクロ修正）
以下のマクロは、EXCEL２００３で 「特定の文字列が含まれている列を削除する」動作をするマクロです Sub Macro1() Const col As String = "A" '文字列が入力されている列 Dim idx As Long Dim keyWord keyWord = Application.InputBox("削除対象の文字列は？", Type:=2) If TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0 Then For idx = Cells(65536, col).End(xlUp).Row To 1 Step -1 If InStr(Cells(idx, col).Value, keyWord) > 0 Then ' If Application.CountIf(Rows(idx), "*" & keyWord & "*") > 0 Then Rows(idx).Delete End If Next idx End If End Sub このマクロを、 「特定の文字列が含まれている行のみを残し、それ以外を削除する」 というマクロに変更したいと思っています。 是非ご回答お願いいたします。
- ベストアンサー
- オフィス系ソフト
- 文字変換マクロについて
数値を文字列に変換するマクロで、行数や列数が増えても対応できるようにしたいです。 （並びは…数値 スペース 文字列）どなたか教えてください。 よろしくお願いします。 Sub 文字() Dim i As Long For i = 1 To Range("A1").End(xlDown).Row Cells(i, "C") = Cells(i, "A") With Cells(i, "C") .NumberFormatLocal = "@" .Value = StrConv(Cells(i, "C").Value, vbNarrow) .Value = Format(Cells(i, "C").Value, "'00") End With Next i End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルマクロで特定の範囲内の検索
A10からA100までのセルを上から順に調べて、セルにAという文字が入力されているときに、その隣にBという文字を入力するマクロを下記のように作りました。 「セルにAという文字が入力されているとき」という条件に加え、「検索しているセルから上の9個のセル（cells(i-9,1)からcells(i-1,1)まで）にAという文字が入力されていない」という条件を加えたいのです。 Sub 検索() Dim i As Integer For i = 10 To 100 If Cells(i, 1).Value = "A" Then Cells(i, 2).value = "B" End If Next i End Sub つまり If Cells(i, 1).Value = "A" Then の部分を If Cells(i, 1).Value = "A" かつ Range(cells(i-9,1),cells(i-1,1))にAが入力されていない Then という形にしたいのですが、表現の仕方がわかりません。 ご教示よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロについて
下記は、A列3行の7文字目～10文字と B列5行～文字のある最後の行までの範囲の左から1文字目～4文字 に相違がある場合 MsgBox i ＆ “行目” を出す。 というマクロなのですが、『B列5行～文字のある最後の行までの範囲』の中でも『空白のセルに関してはMsgBox不要』というふうに付加えたいのですがどのようにすればよいでしょうか。 Sub Macro1() Dim i As Long Dim sOrgText As String Dim ltotal As Long With ActiveSheet sOrgText = Mid(.Cells(3, 1), 7, 4) ltotal = .Cells(65536, 2).End(xlUp).Row For i = 5 To ltotal If Not Mid(.Cells(i, 2), 1, 4) = sOrgText Then MsgBox i & "行目" End If Next i End With End Sub
- ベストアンサー
- SE・インフラ・Webエンジニア
- エクセルマクロ 複数特定文字を含む行以外の削除
M列にある特定の文字が含む行以外のものを削除するマクロを教えて下さい。 現在ネット検索で見つかったマクロを使用しています 【現在使用中のマクロ】 Sub Sample1() Dim i As Long For i = Cells(Rows.Count, "M").End(xlUp).Row To 2 Step -1 If InStr(Cells(i, "M"), "検索したい文字") = 0 Then Rows(i).Delete End If Next i End Sub これだと検索したい文字が1つしか利用できません。 「検索したい文字列1」または「検索したい文字列2」を含まない行を削除したいのですが どのようにマクロを組めばよいのでしょうか？ こちらまったくの初心者です。 上記の書式にはこだわりませんので、わかる方教えて下さい。
- ベストアンサー
- オフィス系ソフト
お礼
セキュリティー面まで改善して下さってありがとうございます。 安心して使うことができます。 No.7の「この回答へのお礼」のところへ、今回のコードのテスト結果を記載いたしました。 また、一点だけお願いを書かせていただきました。 よろしくお願いいたします。