watabe007さま
大変お世話になりました
前にシートのセルにページ番号を追加するVBAをこちらで教えて頂きまして、本当に有難うございます
前回に下記の内容を教えて頂き、大変有難く使わせていただいております
Sub pageA()
Dim i As Long
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Sheet3" Then
Worksheets(i).Range("G2") = "'" & i & "/" & Worksheets.Count
ElseIf Worksheets(i).Name = "Sheet4" Then
Worksheets(i).Range("G3") = "'" & i & "/" & Worksheets.Count
Else
Worksheets(i).Range("G1") = "'" & i & "/" & Worksheets.Count
End If
Next
End Sub
それで、今回はどのシート名にも属さないシートはページカウントとしてカウントしない、という方法がありましたらお教え頂きたいのですが、方法はありますでしょうか?
お忙しいかと思いますが、アドバイス頂けますますと嬉しいです
下記のマクロは、URL先のソースの中に、
「赤ちゃん」「妊婦」「ママ」「水」「ウォーター」
のどれかがあれば、隣に○を付けるというものです。
ですが、
https://www.andrea-pennington.com/
こちらのサイトを調べたところ、
キーワードが全部あるのに、○が付かず--でした。
マクロの記述がどこかおかしいでしょうか?
ソースの中に、どれかのキーワードがあれば、
○が付くようにするには、どのような記述になるでしょうか?
Excel2016です。
よろしくお願いいたします。
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先のソースの中に、
「赤ちゃん」「妊婦」「ママ」「水」「ウォーター」
のどれかがあれば、隣に○を付けるというものです。
ですが、
https://www.andrea-pennington.com/
こちらのサイトを調べたところ、
キーワードが全部あるのに、○が付かず--でした。
マクロの記述がどこかおかしいでしょうか?
ソースの中に、どれかのキーワードがあれば、
○が付くようにするには、どのような記述になるでしょうか?
Excel2016です。
よろしくお願いいたします。
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
下記のマクロは、「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
以下のコードで既に開いているIEをアクティブ化しています。
Dim objIE
set Shell=Wscript.CreateObject("Shell.Application")
for each tmp in Shell.Windows
if TypeName(tmp.document)="HTMLDocument" then
if tmp.LocationURL="指定URL" then
set objIE=tmp
end if
end if
Next
指定URLの部分を完全に一致していた場合ではなく、一部が一致していたら、そのIEをアクティブ化するようにしたいです。可能ならば方法を教えて欲しいです。
現在vbaの勉強中です。
問題集通りに下記コードを設定しました。
a1に20以下の数値、例えば「5」を入力するも、
「成人です」の結果になってしまいます。
20より小さい場合は未成年ですの表記になるはずですが・・・。
Sub mondai()
Sheets("Sheet3").Select
Dim nenrei As Long
nenrei = Range("a1").Value
If nenrei > 20 Then
MsgBox "成人です"
Else
MsgBox "未成年です"
End If
End Sub