指定した語句を含むサイトタイトルを検索する方法| OKWAVE

サイトタイトルに、指定した語句があれば○

下記のマクロは、指定範囲のURL先のソースに、指定した語句があれば、○を付けるマクロです。指定した語句をソース全て対象にせずに、 <title></title>のサイトタイトルの中にあれば、○を付けるというようにしたいです。ちなみに、調べたいのは語句ではないですが、"【"というカッコです。・下記のマクロ URL先のソース全体の中に、指定した語句があれば○ ・希望のマクロ <title></title>（サイトタイトル）の中に、指定した語句があれば○ どの部分を修正、または追加すればできるようになりますか？よろしくお願いいたします。 Sub 指定した語句() '!!!! [Microsoft XML v6.0] に参照設定すること Dim xHttp As IServerXMLHTTPRequest Dim myErr_Number As Long, myErr_Description As String Set xHttp = CreateObject("MSXML2.ServerXMLHTTP") Dim aCell As Range R = 1 For Each aCell In Selection.Columns(1).Cells '選択セルの1列目がURL Application.Goto aCell '対象URLの列にジャンプ表示 DoEvents sUrl = aCell.Value If sUrl <> "" Then xHttp.Open "GET", sUrl, True xHttp.setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, _ SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS ' SSL関係のエラーを無視 On Error Resume Next xHttp.send If xHttp.readyState <> 4 Then xHttp.waitForResponse 5 '5秒まってだめならタイムアウト End If If xHttp.readyState <> 4 Then Err.Raise 1004, , "タイムアウト" myErr_Number = Err.Number myErr_Description = Err.Description On Error GoTo 0 If myErr_Number = 0 Then sHtml = xHttp.responseText nRtn = InStr(sHtml, "指定した語句") If nRtn = 0 Then aCell.Offset(, 1).Value = "--" Else aCell.Offset(, 1).Value = "○" End If Else aCell.Offset(, 1).Value = myErr_Description ' エラー時はエラー内容を表示 End If DoEvents End If Next Set xHttp = Nothing End Sub

"【"が、Shift_JISのサイトで認識できない

下記のマクロは、指定範囲のURL先のソースに、指定した語句があれば、○を付けるマクロです。指定した語句をソース全て対象にせずに、 <title></title>のサイトタイトルの中に、"【"があれば○を付けるというようにしたいです。（クォーテーションマーク抜きの【） https://okwave.jp/qa/q9899670.html こちらで先に質問をして回答をいただいたのが、元のコードの一部を、 If sHtml Like "*<title>*" & "【" & "*</title>*" Then aCell.Offset(, 1).Value = "○" Else aCell.Offset(, 1).Value = "--" End If に変更するというものです。しかし、これだとUTF-8のサイトは認識できますが、 Shift_JISのサイトでは認識できないようです。（【があるのに、○が付かない） UTF-8とShift_JISのサイト両方を認識して、 "【"が、<title></title>の中にあるものに○を付くようにするには、どのようなマクロの記述になりますでしょうか？よろしくお願いいたします。 Sub 指定した語句() '!!!! [Microsoft XML v6.0] に参照設定すること Dim xHttp As IServerXMLHTTPRequest Dim myErr_Number As Long, myErr_Description As String Set xHttp = CreateObject("MSXML2.ServerXMLHTTP") Dim aCell As Range R = 1 For Each aCell In Selection.Columns(1).Cells '選択セルの1列目がURL Application.Goto aCell '対象URLの列にジャンプ表示 DoEvents sUrl = aCell.Value If sUrl <> "" Then xHttp.Open "GET", sUrl, True xHttp.setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, _ SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS ' SSL関係のエラーを無視 On Error Resume Next xHttp.send If xHttp.readyState <> 4 Then xHttp.waitForResponse 5 '5秒まってだめならタイムアウト End If If xHttp.readyState <> 4 Then Err.Raise 1004, , "タイムアウト" myErr_Number = Err.Number myErr_Description = Err.Description On Error GoTo 0 If myErr_Number = 0 Then sHtml = xHttp.responseText nRtn = InStr(sHtml, "指定した語句") If nRtn = 0 Then aCell.Offset(, 1).Value = "--" Else aCell.Offset(, 1).Value = "○" End If Else aCell.Offset(, 1).Value = myErr_Description ' エラー時はエラー内容を表示 End If DoEvents End If Next Set xHttp = Nothing End Sub

「A」「B」「C」「D」のすべての語句があれば○

下記のマクロは、「A」があったら○を付けるというものです。「A」があったら・・・というのを、「A」「B」「C」「D」のすべての語句があれば○、というようにしたいです。それは、どのような記述に変更すればできるでしょうか？よろしくお願いいたします。 Sub main() '!!!! [Microsoft XML v6.0] に参照設定 Dim xHttp As IServerXMLHTTPRequest Dim myErr_Number As Long, myErr_Description As String Set xHttp = CreateObject("MSXML2.ServerXMLHTTP") Dim aCell As Range R = 1 For Each aCell In Selection.Columns(1).Cells Application.Goto aCell DoEvents sUrl = aCell.Value If sUrl <> "" Then xHttp.Open "GET", sUrl, True xHttp.setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, _ SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS On Error Resume Next xHttp.send If xHttp.readyState <> 4 Then xHttp.waitForResponse 5 End If If xHttp.readyState <> 4 Then Err.Raise 1004, , myErr_Number = Err.Number myErr_Description = Err.Description On Error GoTo 0 If myErr_Number = 0 Then sHtml = xHttp.responseText nRtn = InStr(sHtml, "A") If nRtn = 0 Then aCell.Offset(, 1).Value = "--" Else aCell.Offset(, 1).Value = "○" End If Else aCell.Offset(, 1).Value = myErr_Description DoEvents End If Next Set xHttp = Nothing End Sub

キーワードが全部あるのに、○が付かない

下記のマクロは、URL先のソースの中に、「赤ちゃん」「妊婦」「ママ」「水」「ウォーター」のどれかがあれば、隣に○を付けるというものです。ですが、 https://www.andrea-pennington.com/ こちらのサイトを調べたところ、キーワードが全部あるのに、○が付かず--でした。マクロの記述がどこかおかしいでしょうか？ソースの中に、どれかのキーワードがあれば、 ○が付くようにするには、どのような記述になるでしょうか？ Excel２０１６です。よろしくお願いいたします。 Sub main() '!!!! [Microsoft XML v6.0] に参照設定すること Dim xHttp As IServerXMLHTTPRequest Dim myErr_Number As Long, myErr_Description As String Set xHttp = CreateObject("MSXML2.ServerXMLHTTP") Dim aCell As Range R = 1 For Each aCell In Selection.Columns(1).Cells '選択セルの1列目がURL Application.Goto aCell '対象URLの列にジャンプ表示 DoEvents sUrl = aCell.Value If sUrl <> "" Then xHttp.Open "GET", sUrl, True xHttp.setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, _ SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS ' SSL関係のエラーを無視 On Error Resume Next xHttp.send If xHttp.readyState <> 4 Then xHttp.waitForResponse 5 '5秒まってだめならタイムアウト End If If xHttp.readyState <> 4 Then Err.Raise 1004, , "タイムアウト" myErr_Number = Err.Number myErr_Description = Err.Description On Error GoTo 0 If myErr_Number = 0 Then sHtml = xHttp.responseText nRtn = InStr(sHtml, "赤ちゃん") + InStr(sHtml, "妊婦") + InStr(sHtml, "ママ") + InStr(sHtml, "水") + InStr(sHtml, "ウォーター") 　　　　　　　　　If nRtn = 0 Then aCell.Offset(, 1).Value = "--" Else aCell.Offset(, 1).Value = "○" End If Else aCell.Offset(, 1).Value = myErr_Description ' エラー時はエラー内容を表示 End If DoEvents End If Next Set xHttp = Nothing End Sub

URLからタイトルを取得したい！

エクセルのＡ列にはURLがずらっとあり、Ｂ列にタイトル取得を考えています。そこで、他の質問者さんのコードを試しました。その結果、普通のサイトでは問題なく取得できたのですが、アメーバーブログなどの無料ブログでは、途中で止まってエラーとなってしまうようです。どこかいけないのでしょうか？ Public Sub ReadTitle() Dim url As Range Dim Http, buf As String Set Http = CreateObject("MSXML2.XMLHTTP") Set url = Range("A1") Do While (url.Value <> "") Http.Open "GET", url.Value, False Http.Send buf = StrConv(Http.ResponseBody, vbUnicode) '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

サイトタイトルを取得するマクロが「応答なし」になる

下記のマクロは、選択したセルのURLからサイトタイトルを取得するものです。このマクロを使って、１万を越えるURLの作業をやろうとしています。作業に取り掛かったのですが、下記のマクロがすぐに「応答なし」になり、エクセルの画面が真っ白になり、Escでマクロを止めることもできません。ようやくマクロを止めても応答なしのときはマクロが動いておらず、作業が進みません。取得するサイトタイトルの数が多いため、寝てるときにマクロを動かしてやっていきたいです。下記のマクロを「応答なし」にせずに、順調にサイトタイトルを取得していくには、どのような記述にすれば、できるようになるでしょうか？ EXCEL2016です。よろしくお願いいたします。 ↓応答なしになるマクロ Sub サイトタイトル() Dim rng As Range Dim url As String Dim s As String For Each rng In Selection url = rng.Value If url <> "" Then If url Like "*://*" Then s = GetTitle(rng.Value) Else s = GetTitle("https://" & url) If s = "Error" Then s = GetTitle("http://" & url) If s = "Error" Then s = GetTitle("https://www." & url) If s = "Error" Then s = GetTitle("http://www." & url) End If rng.Offset(, 1) = s End If Next End Sub Function GetTitle(url As String) As String Dim http As Object Dim html As Object Set http = CreateObject("MSXML2.XMLHTTP") Set html = CreateObject("htmlfile") GetTitle = "Error" On Error Resume Next http.Open "GET", url, False http.send If http.Status <> 200 Then Exit Function On Error GoTo 0 html.Write http.responseText GetTitle = html.Title End Function

エクセルでURLからタイトルのみを抽出する方法

URLからタイトルを抽出するマクロについて教えて下さい。忍者ブログの記事タイトルをURLから抽出しようとしたのですが文字化けしてしまい全く分かりません。他のサイトやブログだと普通に抽出出来るのですが・・・文字コード？か何かだと思うのですが、原因が分かりません。ちなみに以下のマクロは、ネット上で検索して見つけたものをそのままコピーして使用しています。－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Public Sub ReadTitle() Dim url As Range Dim Http, buf As String Set Http = CreateObject("MSXML2.XMLHTTP") Set url = Range("A3") Do While (url.Value <> "") Http.Open "GET", url.Value, False Http.Send buf = StrConv(Http.ResponseBody, vbUnicode) '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 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－宜しくお願い致します。

下記のマクロをもっと早くするには？

下記のマクロは、 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

エクセルでメタタグを抽出するには？

すいません、前回質問した者です。前回の質問では・・・エクセルシートのB列にURLが並んでいるとして、ＶＢＡを使って、C列には「description」D列には「keywords」を抽出したいという質問をしたのですが、参考になる回答がなかったのでもう一度質問します。以前、私が教えてもらったのは、B列にURLが並んでいて、Ａ列にタイトルを抽出させたものでした。それが以下になります。 Public Sub ReadTitle() Dim url As Range Dim Http, buf As String Set Http = CreateObject("MSXML2.XMLHTTP") Set url = Range("B1") Do While (url.Value <> "") Http.Open "GET", url.Value, False Http.Send buf = StrConv(Http.ResponseBody, vbUnicode) '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 このような感じでＢ列にはURLの一覧があるとして、Ａ列にタイトル、C列にdescription　D列にkeywordsが抽出できればいいなと考えています。ちなみに、私にはＶＢＡの知識がまったくありません。とりあず、これだけ出来れば、すごく助かるのですが、どなたか教えていただけないでしょうか？　よろしくお願いします！

１つの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

ASPをPHPに移植したいですが、よい方法があるでしょうか？

ASPをPHPに移植したいですが、よい方法があるでしょうか？ Set httpObj = Server.CreateObject("WinHttp.WinHttpRequest.5.1") If Err.Number <> 0 Then 'error check for http 　Response.Write("エラー：" & Err.Description) 　response.redirect("/ga-ko/error.asp?error=999") 　response.end End If どうぞ、よろしくお願いします。

エクセルマクロの改良

テキストボックス内に×の文字列があれば、エンターキーを押すたびに×の前にカーソルが行きます。最後の×の後ろにもカーソルが行くようにしたいのですがご教授くださいませ。 If .Value Like "*×*×*" Then s = .SelStart ss = InStr(s + 2, .Value, "×") If ss >= s + 2 Then .SelStart = ss - 1 KeyCode = 0 End If ElseIf .Value Like "*×*×*×*×" Then s = .SelStart ss = InStr(s + 2, .Value, "×") If ss >= s + 2 Then .SelStart = ss - 1 KeyCode = 0 End If

VBAで範囲を指定するには

いつもお世話になります。 WINDOWS7 EXCELL2010 です。下記のマクロを採用していますがその中に適用する範囲を指定したいのです。指定する範囲は　　I13～AM27　です。どんな方法で追加すればいいかご教授を願えませんか。 Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Value = 0 Then Target.Value = " " If Target.Value = 1 Then Target.Value = "日" If Target.Value = 2 Then Target.Value = "△" If Target.Value = 3 Then Target.Value = "▼" If Target.Value = 4 Then Target.Value = "前" If Target.Value = 5 Then Target.Value = "夜" If Target.Value = 6 Then Target.Value = "明" If Target.Value = 7 Then Target.Value = "有" Application.EnableEvents = True End Sub

文字列検索チェック

VB6.0について質問です。 VBからデータベースのデータを読込んでそれに応じたチェックボックスをチェックするという制御がうまくいきません。詳細は、データは空白で区切られていて３つまでは固定された文字で送られてきます。(リンゴバナナオレンジ) これだけだと以下のプログラムで済むのですがこの３つ以外に不確定の文字が入っている場合はその他にチェックを入れたいのですがどのようにプログラムを組めばよいですか？チェックは複数選択可能です。＊targetStringにデータベースからのデータが入ってきます If InStr(targetString, "リンゴ") <> 0 Then Chk1(0).Value = 1 Else Chk1(0).Value = 0 End If If InStr(targetString, "バナナ") <> 0 Then Chk1(1).Value = 1 Else Chk1(1).Value = 0 End If If InStr(targetString, "オレンジ") <> 0 Then Chk1(2).Value = 1 Else Chk1(2).Value = 0 End If

条件による行挿入VBAの統合

Bookごとのデータの内容により次の３つをその都度使い分けていますがこれをひとつのVBAに統合したいのですが書き方を教えてください。 (当方詳しくないのでこのVBAも教えられたままのもので自作ではありません） ※A列データのうちタイトル行には■を先頭に入れてあります。 ●「■」があればすべて分割（■タイトルの上の行に１行挿入） Sub 全分割() Dim r As Long For r = 140 To 2 Step -1 If InStr(Cells(r, "A").Value, "■") > 0 Then Rows(r).Insert End If Next End Sub ●タイトルに(1)または(2)が含まれる場合は (1)の上で分割（■の上の行に１行挿入）、(2)のあるA列はセル消去 Sub かっこ２有り分割() Dim r As Long For r = 140 To 2 Step -1 If InStr(Cells(r, "A").Value, "■") > 0 Then If InStr(Cells(r, "A").Value, "(2)") > 0 Then Cells(r, "C").ClearContents End If If InStr(Cells(r, "A").Value, "(1)") > 0 Then Rows(r).Insert End If Cells(r, "A").ClearContents End If Next End Sub ●上記混在の場合（かっこありタイトルとかっこなしタイトルが混在) Sub 混在分割() Dim r As Long For r = 140 To 2 Step -1 If InStr(Cells(r, "A").Value, "■") > 0 Then If InStr(Cells(r, "A").Value, "(2)") > 0 Then Cells(r, "A").ClearContents End If If InStr(Cells(r, "A").Value, "■") > 0 Then Rows(r).Insert End If End If Next End Sub ※かっこ有りに(3)もある場合、(2)と同じ処理３つを統合した場合の分類のルール A列に■のあるタイトルの処理 ■のあるタイトルごとにタイトルの上に1行挿入ただしタイトルに(2)(3)が含まれる場合は、上に行挿入せずそのタイトル部分(A列)のセル消去 A列の状況 ■タイトルデータ1 データ2 データ3 ■タイトル(1) データ1 データ2 データ3 ■タイトル(2) データ4 データ5 データ6 ■タイトルデータ1 データ2 データ3 A列の処理状況 (行挿入) ■タイトルデータ1 データ2 データ3 (行挿入) ■タイトルデータ1 データ2 データ3 (空白) データ4 データ5 データ6 (行挿入) ■タイトルデータ1 データ2 データ3 なおデータの数字（連番)はD列に入れてありますが、上記ルールにより■のあとや(2)(3)のとき同一タイトルなら連番にしてあるのでこの1の行を分割の判定としてもいい Office2013/Windows7

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

下記のマクロは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 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－宜しくお願い致します。

指定した文字列が含まれる行を削除する

データの照合をしています。指定した文字列が、「Ｏ列」に入っていたら、その行を削除し、行をつめるというようなマクロを組みたいのですが、エラーがかかってしまいます。（下のＶＢは、ネットで公開されていたのを使用させていただいております。） 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 「下から３行目のＮＥＸＴに対応するｆｏｒがない」とエラーがでます。ご教授、お願いいたします。

Excel VBA　列の最後の値を代入

たびたびすみません。指定したセルの、最終列の値を、任意のセルに入れたいのですが、オブジェクトが必要です、というエラーがでます。 Sub 単価代入() Dim i As Integer Application.ScreenUpdating = False For i = Range("IV2").End(xlToLeft).Column To 1 Step -1 If InStr(Cells(2, i).Value, "単価") > 0 Then Cells(3, i).Value = Cells(3, i).End(xlToRight).Column.Value End If Next i Application.ScreenUpdating = True End Sub Cells(3, i).Value = のあとの指定方法がまずいのかと思いますが。。どうぞ宜しくお願い致します。

マクロのコーディング

すいません、下のコード（マクロなんですが）同じ処理を4回も繰り返しているので、(入りきらないので、2回にしました)ひとつにまとめたいです。どうすればいいでしょうか？教えて下さい。 '●業務番号チェック 'エラー時は青 If Range("H39:I39").Select <> "" Then If .Cells(43, 5).Value = "" Then Total_Check_Flg = True '色付の範囲の設定 Range("A43:B43").Select 'セルの色の設定（青） With Selection.Interior .ColorIndex = 41 End With Err_Kazu_4 = Err_Kazu_4 + 1 End If End If If Range("K39:L39").Select <> "" Then If .Cells(44, 5).Value = "" Then Total_Check_Flg = True '色付の範囲の設定 Range("A44:B44").Select 'セルの色の設定（青） With Selection.Interior .ColorIndex = 41 End With Err_Kazu_4 = Err_Kazu_4 + 1 End If

VBS

VBSであるファイルを１行ずつ読み込み、その読み込んだ値をある別のファイルにリダイレクトしたいのですが、どのように書けばよいか教えてください。下記のように、echoでは出すことができるのですが、ファイルにリダイレクトというのができません。よろしくお願いします。 ==== sample shell ========================= Option Explicit On Error Resume Next Dim objFSO ' FileSystemObject Dim objFile ' ファイル読み込み用 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then Set objFile = objFSO.OpenTextFile("d:\dr1.txt") If Err.Number = 0 Then Do While objFile.AtEndOfStream <> True WScript.Echo objFile.ReadLine Loop objFile.Close Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objFile = Nothing Set objFSO = Nothing ============================================================

指定した語句を含むサイトタイトルを検索する方法

サイトタイトルの中に、指定した語句があれば○

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

その他の回答 (1)

関連するQ&A

サイトタイトルに、指定した語句があれば○

"【"が、Shift_JISのサイトで認識できない

「A」「B」「C」「D」のすべての語句があれば○

キーワードが全部あるのに、○が付かない

URLからタイトルを取得したい！

サイトタイトルを取得するマクロが「応答なし」になる

エクセルでURLからタイトルのみを抽出する方法

下記のマクロをもっと早くするには？

エクセルでメタタグを抽出するには？

１つのPCで同じマクロを複数動かす

ASPをPHPに移植したいですが、よい方法があるでしょうか？

エクセルマクロの改良

VBAで範囲を指定するには

文字列検索チェック

条件による行挿入VBAの統合

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

指定した文字列が含まれる行を削除する

Excel VBA　列の最後の値を代入

マクロのコーディング

VBS

注目のQ&A

カテゴリ

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

専門家に質問してみよう

指定した語句を含むサイトタイトルを検索する方法

サイトタイトルの中に、指定した語句があれば○

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

その他の回答 (1)

関連するQ&A

サイトタイトルに、指定した語句があれば○

"【"が、Shift_JISのサイトで認識できない

「A」「B」「C」「D」のすべての語句があれば○

キーワードが全部あるのに、○が付かない

URLからタイトルを取得したい！

サイトタイトルを取得するマクロが「応答なし」になる

エクセルでURLからタイトルのみを抽出する方法

下記のマクロをもっと早くするには？

エクセルでメタタグを抽出するには？

１つのPCで同じマクロを複数動かす

ASPをPHPに移植したいですが、よい方法があるでしょうか？

エクセルマクロの改良

VBAで範囲を指定するには

文字列検索チェック

条件による行挿入VBAの統合

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

指定した文字列が含まれる行を削除する

Excel VBA 列の最後の値を代入

マクロのコーディング

VBS

注目のQ&A

カテゴリ

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

専門家に質問してみよう

Excel VBA　列の最後の値を代入