これは、以前ここで教示していただいたWEBからデータを取り出すVBAの一部です。
日付を入力し、その都度呼び出すWEBページを指定するものです。
--------------
myDate = InputBox("オープンする日付を「月/日」のように入力してください。", _
"日付の入力", Format(Date, "m/d"))
myURL = "0062/0062" & Format(Split(myDate, "/")(0) * 1, "00") & _
Format(Split(myDate, "/")(1) * 1, "00")
Connection_URL = "http://***/" & myURL & ".html"
-----------------
これは日付の当てはめにより(1/10の場合)
http://***/0062/00620110.htmlとなるようです。
そこで今回新たに指定したいurlは
http://***/guid/?datest=2011-01-10&ch=109
というものです。この中の-01-10の部分を日付指定により可変としたいのですが
ハイフンがはさまるため上記のVBAを変える必要があるようです。
VBAは初心者のため、元記述を色々書き換えて見たのですがうまくゆきません。
なお、chの部分も変えるとしたらをあわせて、アドバイスをよろしくお願いします。
No.1ベストアンサー
- 回答日時:
最初のコードは、
> http://***/0062/00620110.htmlとなるようです。
とするなら、以下になるのではありませんか?ただし、CDate(myDate)というのは、荒っぽい書き方です。
Sub Tes1()
myDate = InputBox("オープンする日付を「月/日」のように入力してください。", "日付の入力", Format(Date, "m/d"))
'本来は、エラー処理をここでする
myURL = "0062/0062" & Format(CDate(myDate), "MMdd")
Connection_URL = " http://***/" & myURL & ".html"
End Sub
> http://***/guid/?datest=2011-01-10&ch=109
109というのは何か分かりませんが、他が、定数なら、以下のようになるはずです。
こちらは、最低限のエラー処理はされています。
Sub Tes2()
Dim myDate As Variant
Const T As String = "109"
myDate = Application.InputBox("オープンする日付を「月/日」のように入力してください。", "日付の入力", Format(Date, "m/d"), Type:=2)
If IsDate(myDate) = False Then Exit Sub
Connection_URL = " http://***/guid/?datest=" & Format(myDate, "yyyy-MM-dd") & "&ch=" & T & ".html"
End Sub
それから、「オープンする日付を「月/日」のように入力してください。」でなくても、yyyy/mm/dd スタイルでも可能なはずです。
ありがとうございました。
表示様式を指定して記述すればいいのですね。
myURL = "0062/0062" & Format(Split(myDate, "/")(0) * 1, "00") & _
Format(Split(myDate, "/")(1) * 1, "00")
を生かさねばと思って""などでつないでいました。
一応urlの表示はうまくいっている用なのですが、「http://**」は開けません。
インターネットに接続できません」とメッセージが出ちゃうんです。
WEBクリエで呼び出すとちゃんと張り付けることができるんですけどね。
なお、上記VBAのうち後段が抜けていました。
--html"のあと
Columns(1).ClearContents
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Connection_URL, Destination:=Range("A1"))
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.Refresh BackgroundQuery:=False
End With
End Sub
これでエクセルに張り付けています。
No.2
- 回答日時:
>一応urlの表示はうまくいっている用なのですが、「
http://**」は開けません。>インターネットに接続できません」とメッセージが出ちゃうんです。
たぶん、URLが、間違っているには違いないとは思います。
http://***/guid/?datest=2011-01-09&ch=109.html
例えば、貼りつけた後に、自動的に別のコードに変わっているとか、確認してください。
たぶん、どこかの放送の番組表のようですが、こちらでは、今のところ、調べようがありません。自己解決を望みますが、試せれば、こちらでチェックします。
お勧めしませんが、Google の短縮URLを使えば、後で消えてしまいますから、それを使ってもよいと思います。(たぶん、クレームがついた時には、もうURLは役に立たなくなっています。)
Google URL Shortener
http://goo.gl/
そこで生成されたを貼り付けてもよいです。2時間から、1日、1週間、ひと月、また恒久的なものがあります。
教えて!goo のURL http://goo.gl/qz5H7 (11/02/09 まで有効)
なお、#1のお礼欄で書かれたマクロに関しては、はっきりと明言できませんが、こういうスタイルにしたほうがよいです。
ActiveSheet.QueryTables(1).Delete
ActiveSheet.Range("A1").CurrentRegion.ClearContents
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Connection_URL, Destination:=Range("A1"))
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.Refresh BackgroundQuery:=False
End With
#6129006 昨年の8月のご質問をひと通りざっと読みましたが、ずいぶん長く続いたようで、今回の流れの一部は、そこからのようです。そのスレのNo.29は同意しますが、私は、あまり質問者さんのレベルには斟酌を加えずに、フリーで許される範囲でコードを書きます。しかし私は、せいぜい数回程度の返事で、最近は元気はありません。特に、こちらのカテゴリでは、トラブルが多発したせいで、あまり書きません。
もう一度最初から整理させていただきます。
下記は現在使用しているVBAです
※別のurlから取り込みたいために
それに適した記述に変更したいと考えています。
下記のurlはhttp://www.***/0062/00620109.html
です。
直したい別のurlは
http://www.***/?datest=2011-01-11&ch=109
のような記述になります。
-------------------
Sub Using_Web_query30A()
Dim arrMenu As Variant
Dim myDate As String
Dim myURL As String
Dim Connection_URL As String
arrMenu = Array(70, 80, 32, 62, 101, 102, 90, 120, 40, 22, 31)
myDate = InputBox("オープンする日付を「月/日」のように入力してください。", _
"日付の入力", Format(Date, "m/d"))
myURL = "0062/0062" & Format(Split(myDate, "/")(0) * 1, "00") & _
Format(Split(myDate, "/")(1) * 1, "00")
Connection_URL = "http://***/" & myURL & ".html"
Columns(1).ClearContents
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Connection_URL, Destination:=Range("A1"))
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.Refresh BackgroundQuery:=False
End With
End Sub
※arrMenu = Array…は不要なものです。
------------------------
ご指示いただいたVBAで発生した、エラーメッセージをじっくり見る限り
URLはしっかりと組成されていました。
WebTables = "9"というのは数字の持つ意味がよくわかりませんが
新URLだと変える必要があるかと思います。
gooのショートアドレスってなかなかいいですね。
早速2時間のアドレスを作りました
よろしくお願いいたします
No.3
- 回答日時:
今回の直接のエラーの原因は、「.Refresh BackgroundQuery:=False」の部分のはずです。
私が、ちょっと洒落たことをしようとしたのが原因です。しかし、それでエラーが返らなくても、QueryTables のVBAでは、サイトに訪れた人の情報を与えないので、取れないことがあります。
それと、良く分かりませんが、文字コードが単純ではないようです。教えて!goo などは、構造はものすごく複雑ですが、文字コードは単純です。目的の所は、Webサイトの構造自体は単純ですから、取得自体は、何ら問題ありません。
それで、今までのコードは、前回もちょっと書いたと思いますが、ほとんど定数以外は参考にはしません。
今回は、UserForm にまとめると良いと思います。
>※arrMenu = Array…は不要なものです。
もし使うなら、本来、これは、UserForm上のComboBox などを利用すると良いと思います。そこに、CommandButtonでアクセスするようにして、もう一つのComboBox を設けて、日付の範囲を予め作ってしまってもよいのではないかと思います。
InputBox をあれこれいじってみましたが、マウスだけで入力も出来ません・InputBox は使いづらいです。
> .WebTables = "9"
私もここが分かりません。Webクエリを記録マクロで取っても、それが出てきませんでした。
一覧のリストが取れればそれで良いような気がします。
しばらくお待ちください。一応、変更は可能ですが、こちらで、一旦レイアウトは決めされていただきます。
お手数をおかけします。
コードについては色々な方法があると思うので、目的のデータが取れればいいので、従来のコードは無視していただいてけっこうです。
rrMenu の部分は私もcomboがいいかなと思って前回も提案しましたが、今回も109に相当する部分はそれを使いたいと思っています。
内容は123,108,109,110,201,202,204,205からの選択になり、123をデフォルトにしたいと思っています。
日にちは入力のほうがよさそうですが、comboのほうが適していればそれでもかまいません。
ただ、デフォルト表示はリアル日付(その日の日付)がやりやすいです。
元サイトは日付もコンボになっていますが、1-31までが長すぎるのと月末から翌月1日に移るのにいつもめんどうに感じています。
よろしくお願いいたします。
No.4
- 回答日時:
最初に、返事が遅くなりましたことと、今回は、私の勘違いで、ご迷惑をおかけしたことをお詫びいたします。
私が、ヘルプを読んでいなかったことが原因で、取消不能だということが分かりました。Google IDを持つ人が、Google Shorter をクリックした回数を調べるために、時間や日付があることでした。そこで、すぐに、こちらの運営側に、訂正をしてただくようにお願いしまた。また、10日から、高い熱を出して、こちらの書き込み出来なくなってしまいました。今回は、全力をあげて、対処させていただくことで、お詫びに返させていただきます。
'//標準モジュールに貼りつけてください。
Sub GetGlobalObject()
Dim objHTTP As Object
Dim httpLog As String
Dim ar As Variant
Dim ret As VbMsgBoxResult
Dim i As Long, j As Long, y As Long
Dim iDate As Variant, myDate As Variant
Dim strURL As String
Dim sChan As Long
sChan = 118 'チャンネル
'チャンネルのチェック
Select Case sChan
Case 101 To 126, 200 To 224
Case Else: MsgBox "チャンネルが違うようです。", vbExclamation: Exit Sub
End Select
Const baseURL As String = "http://****************/guid/?datest="
myDate = Application.InputBox("オープンする日付を「月/日」のように入力してください。", "日付の入力", Format(Date, "m/d"))
If Not IsDate(myDate) Then MsgBox "正しい日付を入力してください。", vbExclamation
If VarType(myDate) = vbBoolean Then Exit Sub
myDate = Format$(myDate, "yyyy-MM-dd")
strURL = baseURL & myDate & "&ch=" & CStr(sChan)
If Application.CountA(Columns("A:B")) > 0 Then
ret = MsgBox("この下に続けますか、前のデータを削除しますか?", vbQuestion + vbYesNoCancel)
If ret = vbYes Then
ActiveSheet.Columns("A:B").Clear
ElseIf ret = vbCancel Then
Exit Sub
End If
End If
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Open "GET", strURL
'objHTTP.SetRequestHeader "User-Agent", "Mozilla/5.1 (Windows; U; Windows NT 5.0; en-JA; rv:1.9.2.13)"
objHTTP.Send
If objHTTP.status = 200 Then
httpLog = objHTTP.ResponseBody
httpLog = StrConv(httpLog, vbUnicode)
With ActiveSheet
y = .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(y, 1).Value = "" Then
.Cells(y, 1).Value = myDate
Else
.Cells(y + 1, 1).Value = myDate
End If
End With
ar = Split(httpLog, "class=""guid", , 1)
If UBound(ar) < 2 Then MsgBox "現在のURLではログが取れていません。", vbCritical: Exit Sub
'次に続く
体調お悪い最中にも関わらず大変長文なVBAを作っていただきありがとうございました。
最初はやはりエラーが出てしまったので、「.status」を外してみたところばっちりとうまくゆきました。
しかも今回の優れ物はタイトルとアーティスト名が別のセルに分離されたことです。前回までのだと、ワークシートの中で@find関数などを使って分離していました。これならこのあと作成するデータシートの作成にあたって大幅に関連の関数の使用が省略できそうです。ありがとうございました。
コードをじっくり見ても残念ながら素人の小生には難読ばかりで手に負えませんが、そのまま張り付けられれば理解できていなくてもデータが取れるので助かります。
分離にあたって関数を使うと"["を見つけてそこからうしろを別のセルにする訳ですが、応用として前回時の別のURL(No26)のも最小限の修正でこれが使えないかなと思い、この"["が"/"(全角のスラッシュ)だったらどこを直すのかとコードを眺めましたがそれらしきものが見つかりません。
前回のurlのデータの場合は"/"と"<"で仕切られています。
URLは多分Const baseURL のurlと書式のyyyy-MM-ddを直せばいいのかなと思っています。
gooの短縮アドレスは入力したあと、よく読んだら時間で消失するような内容でなかったので、困ったなと思っていましたが、サポートの方で消してもらえてよかったです。(時間ごとにアクセス数をカウントしているようでした)
今回は貴重な時間をとらせてしまい申し訳なく思っています。
ほんとうにありがとうございました。
No.5
- 回答日時:
'前回の続き
For i = 1 To UBound(ar)
CutandPaste (ar(i))
Next
Else
MsgBox "Err " & .status, vbCritica
'もしエラーが発生するようでしたら、objHTTP.SetRequestHeaderのコメントブロックを
'外してください。
Exit Sub
End If
With ActiveSheet
For i = y + 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If InStr(1, .Cells(i, 1).Text, ":", 1) > 0 Or _
InStr(1, .Cells(i - 1, 1).Text, ":", 1) > 0 Then
i = i + 1
ElseIf InStr(1, .Cells(i - 1, 1).Text, ":", 1) = 0 And _
.Cells(i - 1, 1).Interior.ColorIndex = xlNone Then
.Cells(i, 1).Resize(, 2).Interior.ColorIndex = 19
End If
Next
.Columns("A:B").AutoFit
.Range("A1").CurrentRegion.HorizontalAlignment = xlLeft
Application.Goto .Cells(y, 1), True
End With
Set objHTTP = Nothing
End Sub
Function CutandPaste(sLine As Variant)
Dim TimeTable As Variant
Dim i As Long, j As Long, m As Long, k As Long, n As Long, y As Long
Dim ar As Variant, s() As String, a() As String
i = InStr(1, sLine, "h3"">", 1)
If i > 0 Then
j = InStr(1, sLine, "</h", 1)
TimeTable = Mid(sLine, i + 4, j - i - 4)
ar = Split(sLine, "</span></li>", , 1)
ReDim s(UBound(ar), 0)
ReDim a(UBound(ar), 0)
For i = 0 To UBound(ar)
j = InStr(1, ar(i), "=""song"">", 1)
If j > 0 Then
k = InStr(j + 8, ar(i), "</span>", 1)
s(i, 0) = Mid(ar(i), j + 8, k - j - 8)
m = InStr(1, ar(i), "=""artist"">", 1)
n = InStr(m, ar(i), "]", 1)
a(i, 0) = Mid(ar(i), m + 15 + 8, n - m - 23)
End If
Next
End If
If UBound(s) > 0 Then
With ActiveSheet
y = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
.Cells(y, 1).Value = TimeTable
.Cells(y, 1).Font.Bold = True: .Cells(y, 1).Font.ColorIndex = 9
.Cells(y + 1, 1).Resize(UBound(s)).Value = s
.Cells(y + 1, 2).Resize(UBound(s)).Value = a
End With
End If
End Function
しばらく試してみてください。マクロは、118になっていますが、109など、ご希望のチェンネルを手動入力してください。今回は、手入力なので、エラーチェックを入れました。QuaryTableのような応用力はありません。ソースから切り分けのコードを探し、そこから、文字を取り出す方法です。慣れれば、難しくはありません。
No.6
- 回答日時:
MsgBox "Err " & .status, vbCritical
↓
MsgBox "Err " & objHTTP.status, vbCritical
としてください。このエラーが出たと言って、その状態(status)を掲示板で聞いても回答する人は少ないし、解決しないとは思いますが、通常、相手のサーバーエラーだと思ってよいです。「HTTP ステータスコード」で、検索してみてください。解決策は、しばらく、時間を空けてアクセスするか、'ObjTTPのコメントブロックを外します。
>httpLog = StrConv(httpLog, vbUnicode)
この行の後に、httpLog は、テキストですから、ここから、切り分けの部分を探します。ただ、Debug.Print ですと、完全に取れないことがあります。今回は、Mid関数で切り分けてしまいました。その分、読みにくいところがあります。
今回のマクロは、他のサイトでは応用できません。サイト専用です。もし、使うなら、新たな組み立てが必要です。正規表現を使えば楽なると思います。しかし、Webサイトでは、きちんとしたものは出ていません。
>前回時の別のURL(No26)のも最小限の修正でこれが使えないかなと思い、
もし今のスタイルと同じにするなら、サイトのソースが必要です。今回の場合は、ResponseBodyでとっていますが、ややこしいのは、文字コードが何種類もあるということです。しかし、ResponseBodyでないこともあります。これをDecode するのは、JavaScriptやADODBなどの文字コードの知識が必要です。私自身、まだ、勉強中です。
大事なことは、そのサイトの構造を捉えてください。
ここのサイトがややこしいのは、画像などは、別のサイトのリンクをされていることで、二重に取得しない見れない時があります。
>前回時の別のURL(No26)
私が書くとこういうスタイルになります。実際のURLが分かりませんと、解析できません。本来は、ComboBox を付けるとよいです。ComboBox は、最初のインデックス 0は、空白にします。また、数字は、1.THE CLASSIC,2.THE JAZZ というような、1,2 が不要です。
今回は、Input関数を使いましたが、本来は、使ってはいけないというのが、暗黙のルールです。それは、非選択(Cancel)の方法が、古い関数をつかなくてはならなくなります。
一部省略しています。
Sub Test1()
Dim ret
Dim mnNames
Dim mnNos
Dim myUrl As String
Dim sUrl As String
Dim i
Dim cnURL As String
Dim myDate
Const baseURL As String = "http://www.musicbird.jp/program/"
Const MNNO As String = "70, 80, 32, 62, 101, 102, 90, 120, 40, 22, 31"
Const MNNAME As String = "1.THE CLASSIC,2.THE JAZZ,3.SWING EASY,4.歌謡&演歌,5.ROCK"
mnNames = Split(MNNAME, ",")
mnNos = Split(MNNO, ",")
ret = InputBox(Join(mnNames, vbCrLf), "メニューの選択", 1)
If Val(ret) < 1 Or Val(ret) > (UBound(mnNames) + 1) Or StrPtr(ret) = vbBoolean Then Exit Sub
i = mnNos(Val(ret) - 1)
myUrl = Format(Val(i), "0000")
myDate = Application.InputBox("オープンする日付を「月/日」のように入力してください。", "日付の入力", Format(Date, "m/d"), Type:=2)
If IsDate(myDate) = False Or VarType(myDate) = vbBoolean Then Exit Sub
myDate = Format(myDate, "MMdd")
sUrl = myUrl & "/" & myUrl & myDate
cnURL = baseURL & sUrl & ".html"
Debug.Print cnURL
End Sub
OKWEBは無関係のリンク先を記述すると回答自体も消去されるケースがあり当方もその部分はアスタリスクを使っていたのですが、No26のときにurlをうっかり回答者がそのままコード中に記載してしまったものが残っているもので、今回、解析用にご案内したのですが、内容については、このあと色々変化しているためあまり参考にならないかもしれません。
いずれにしても、前回の内容に及ぶのは今回の質問の趣旨に反するかもしれないのでこれ以上触れるないことにしようと思います。せっかくご提示いただいたコードは参考までに自分なりに勉強しつつ解読してみたいと思います。
No.7
- 回答日時:
#5 のコードは、以下に変えたほうがよいです。
色分けで、上手く行かないところが出ています。With ActiveSheet
For i = y + 3 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 1).Text Like "*#:##*" Or _
.Cells(i - 1, 1).Text Like "*#:##*" Then
i = i + 1
ElseIf Not .Cells(i - 1).Text Like "*#:##*" And _
.Cells(i - 1, 1).Interior.ColorIndex = xlNone Then
.Cells(i, 1).Resize(, 2).Interior.ColorIndex = 19
End If
Next
.Columns("A:B").AutoFit
.Range("A1").CurrentRegion.HorizontalAlignment = xlLeft
Application.Goto .Cells(y, 1), True
End With
Set objHTTP = Nothing
End Sub
この回答への補足
すみません。ひとつだけ追加で教えてください。取得したデータについて
16:00/○○のパターン
で始まる行の直前に空白行を1行挿入する
ということが現在のVBAの中で同時処理(追記)することは可能でしょうか?
(Ch123のデータ)
"16:00","○○"はその都度異なるが"**:**/"(全角)は統一パターン。
(ほかに17:00という行があるがこちらは半角で該当せず)
お手数をおかけします。
No5のコードでGETしたデータのところどころに文字色の異なるものがあって不思議に思っていましたが、なにかのエラーを意味するものだったんですね。
今回のWith ActiveSheet以下はコードの後ろの方にもあって最初はそっちを直してしまいました。
数回後に気がついて、今度は、色文字が途中の段落(時間)以外はすべて黒になりました。
No6のMsgBoxの修正もご指示どおりにしました。
これでほぼ問題なくデータが取れるようになりました。
ありがとうございました。
No.8
- 回答日時:
#7 の補足の件
やはり、Like 演算子は表現力が今ひとつのようです。
>"16:00","○○"はその都度異なるが…
どうやら、その都度異なる、というのが事実のようですね。今のところは書式で追いかけいますが、統一性が取れないと2列目で判定をさせたほうがよいかもしれません。この部分は様子見です。
>16:00/○○のパターン
>で始まる行の直前に空白行を1行挿入する
今の範疇で押さえたいと思いましたが、基本的には違う流れのようですのでコードを加えました。
後ろEnd Sub から、With ActiveSheet を探してください。
With ActiveSheet
For i = y + 3 To .Cells(Rows.Count, 1).End(xlUp).Row
If VarType(.Cells(i, 1).Value) = vbDouble And _
.Cells(i, 1).Text Like "?#:##" Then
i = i + 1
ElseIf StrConv(.Cells(i, 1).Text, vbNarrow) Like "*#:##*" Or _
StrConv(.Cells(i - 1, 1).Text, vbNarrow) Like "*#:##*" Then
i = i + 1
ElseIf Not StrConv(.Cells(i - 1).Text, vbNarrow) Like "*#:##*" And _
.Cells(i - 1, 1).Interior.ColorIndex = xlNone Then
.Cells(i, 1).Resize(, 2).Interior.ColorIndex = 19
End If
Next
Application.ScreenUpdating = False
For j = .Cells(Rows.Count, 1).End(xlUp).Row To y + 1 Step -1
If StrConv(.Cells(j, 1).Text, vbNarrow) Like "##:##?*" Then
.Cells(j, 1).Resize(, 2).Insert
.Cells(j, 1).Resize(, 2).Interior.ColorIndex = xlNone
End If
Next j
Application.ScreenUpdating = True
.Columns("A:B").AutoFit
.Range("A1", .Cells(i, 1)).HorizontalAlignment = xlLeft
Application.Goto .Cells(y, 1), True
End With
Set objHTTP = Nothing
End Sub
p.s. 質問とは離れますが、誤解を恐れずに、今後のためにも書かせていただきます。
#6のお礼の中で、
>OKWEBは無関係のリンク先を記述すると回答自体も消去されるケースがあり…
今回は、削除されたり訂正されるような内容ではありません。オンデマンドのはずです。No.2を書いた後に、GoogleのHelpを読み、Help掲示板で同じような問題で解決していないことが分かりました。そこで、9日の深夜に「教えて!goo」を通してOkWave側に、メールで、noro6857さんに問い合わせるようにお願いしました。それがこちらの経緯です。もし、それ以前のOkWaveのメールなら、私の思い違いです。
なお、ここのカテゴリで調べてみましたが、最近、OkWaveのプライバシーの考え方が変わったようです。人には、それぞれの事情があります。この話は別の場所で書きましたが、赤の他人には関係ないことも、本人の身近かな人にとっては、ちょっとしたことで、本人が浮き彫りになって、今後のお仕事などに余計な障害になる可能性があります。
ここの質問者の中には、自分の持っているサイト(例:ジオシティーズ)や匿名のレンタル・ダウンロードサイトにアップロードして、不要になれば消してしまう人もいます。今回、他者の10/8/14の質問で、まだ残ってることを確認してまいす。
今回は、URLがないと、文字コードの組み合わせからデコードするのは不可能に近いです。だから、イレギュラーな手段も、現在は質問者には許されている行為だと思います。また、いろんな抜け道は、お互いに探してみる必要がありそうです。
この回答への補足
それから、日付入力の際、デフォルトで当日の日付がハイライトされていますが、これをほかの日付にしようとすると=$A$1というふうに表示されます。これをいったん消去して1/18と入力すれば別にかまわないのですが、もしかしたらどこかのバグかもしれません。
補足日時:2011/01/15 08:25毎回ながらご丁寧な回答をありがとうございます。
早速要望のコードを作ってくださり、目的どおりの結果を得ることができました。
ただ、実はちょっといいにくいことですが、前回の質問(補正)を入力した直後に、気がついたのですが、挿入したいのが1行でなく3行だったんです。
申し訳ないですが、もし若干の修正ですむのならよろしくお願いします。大幅改造になるならこのままでけっこうです。
なお、投稿制限の件、以前に削除理由はよくわかりませんが、私自身も体験したことがあったので、その後はかなり神経質になりながら投稿しています。
たしかに今回の例題のように検証するには実際のurlがあった方が回答される方も回答しやすいと思ってはいるので遠回しにしながら書いていたのですが。
内容にもよるのかもしれませんが、helpから自己判断するにはちょっとむつかしいです。
今回は12日に「違反基準に該当するので修正します」という通知を受けました。
No4(1/12)の記述によりあとからわかったことですが、たぶんWendy02様の要請を受けてでの判断かと思います。
No.9
- 回答日時:
返事が遅くなってすみません。
>今回は12日に「違反基準に該当するので修正します」という通知を受けました。
それは、大変失礼しました。私の依頼メールの趣旨(11/01/10 深夜)は、あくまでも、私のミスのためによるものだから、ご本人に、問い合わせしてほしいというものです。ここのログは読んだ上のこととは思いますが、あまり考えて文章を書いている様子はありません。今回のことは、誤解を与えたことになってしまったかもしれません。
>以前に削除理由はよくわかりませんが
多くは、閲覧者の会員の連絡によるオンデマンドです。サーバーの何かで検索しているものもありますが、引っかかるものは、もう滅多にありません。運営側は連絡を受けて、緊急のものと、そうでないものを区分けして、緊急のものから手を付けているようです。今回のものは、こちらの要請で緊急性があったと信じます。通常は、削除されることはありません。
さて、プログラムのほうは、また再び、下のEnd Sub から書き換えてください。まだ、集中力が戻ってこないで、ミスがあるかもしれません。
なお、
>For j = .Cells(Rows.Count, 1).End(xlUp).Row To y + 3 Step -1
y + 3 のy は、最初の行で、通常は 1ですから、行の挿入の検査は、4行目からということになります。もし、それ以下の行も入れる場合は、+3 を外して、y+1 にもどしてください。でも、y は削除しないでください。
Application.ScreenUpdating = False
For j = .Cells(Rows.Count, 1).End(xlUp).Row To y + 3 Step -1
If StrConv(.Cells(j, 1).Text, vbNarrow) Like "##:##?*" Then
.Cells(j, 1).Resize(3, 2).Insert Shift:=xlShiftDown
.Cells(j, 1).Resize(3, 2).Interior.ColorIndex = xlNone
End If
Next j
Application.ScreenUpdating = True
.Columns("A:B").AutoFit
.Range("A1", .Cells(i, 1)).HorizontalAlignment = xlLeft
Application.Goto .Cells(y, 1), True
End With
Set objHTTP = Nothing
End Sub
今回のものは、QueryTable でも、なんとかなりますが、たぶん、スピードが違うはずです。
何と言っても、下に続けることも出来れば、3列目から入れることも出来ますし、レイアウトも、同時に処理してしまいます。一週間、連続取得するとか、そういう方法も可能かと思います。
ありがとうございました。
作業をしているうちに気がついたのですが
行挿入について依頼が正確でなかったかもしれません。
作成していただいたコードはA列B列の呼び込みデータについて
空白行を挿入していただいていますが、
たぶんA列B列のみ「行移動」処理をされているようで
結果的にほかの列にある関数(M列、L列等)のA,Bを引用しているセルが変化してしまいました。
挿入すれば当然引用セルは変化しますが、行全体を変化させる必要があったわけです。
※ただし、これは前回までの検証により記述しています。
16行目の関数(呼び出すシートのL列~T列に各種関数があらかじめ入れてある。例はN列)
=IF(K16="A","■6",IF(L16="","",+B16))
今回の処理(A16,B16の前に1行挿入)をするとA16,B16のみが変化
=IF(K15="A","■6",IF(L15="","",+B15))
挿入行(=IF(K16="A","■6",IF(L16="","",+B17))
=IF(K17="A","■6",IF(L17="","",+B18))
希望としては
ワークシートの行挿入(16の前に行全体の挿入)をすると
(今回3行にする)
=IF(K15="A","■6",IF(L15="","",+B15))
(挿入行)算式なし
(挿入行)算式なし
(挿入行)算式なし
=IF(K19="A","■6",IF(L19="","",+B19))(全体が変化)
という方法にしたかったのです。
この方法が可能かどうかはわかりませんが、とりあえずお尋ねさせていただきました。
わがままをいってすみません。
ついでにもうひとつアドバ゛イスをお願いします。
次のコードは単独セルの消去ですが、複数のときの表記方法を教えてください
例(1)L列~P列の連続の場合、
例(2)L列,N列,P列のようにとびとびの場合
'A列が「空白」の場合、L列のセルを クリア
Columns("A:A").SpecialCells(xlCellTypeBlanks).Offset(11).ClearContents
No.10
- 回答日時:
Application.ScreenUpdating = False
For j = .Cells(Rows.Count, 1).End(xlUp).Row To y + 3 Step -1
If StrConv(.Cells(j, 1).Text, vbNarrow) Like "##:##?*" Then
.Cells(j, 1).Resize(3).EntireRow.Insert Shift:=xlShiftDown '←ここを書き換え
.Cells(j, 1).Resize(3, 2).Interior.ColorIndex = xlNone
End If
Next j
Application.ScreenUpdating = True
.Columns("A:B").AutoFit
.Range("A1", .Cells(i, 1)).HorizontalAlignment = xlLeft
Application.Goto .Cells(y, 1), True
End With
Set objHTTP = Nothing
End Sub
このように書き換えてあげれば、良いはずです。
ところで、
>=IF(K16="A","■6",IF(L16="","",+B16))
事情が分かりませんので、今は、ご要望の挿入という形で提示していますが、この程度の範囲は、マクロで処理してもよいような気がします。また、そのほうが楽かと思います。
-----
> 'A列が「空白」の場合、L列のセルを クリア
> Columns("A:A").SpecialCells(xlCellTypeBlanks).Offset(11).ClearContents
>例(1)L列~P列の連続の場合、
>例(2)L列,N列,P列のようにとびとびの場合
On Error Resume Next
Set r = Range("A:A").SpecialCells(xlCellTypeBlanks)
If Not r Is Nothing Then
Intersect(r.EntireRow, Columns("L")).ClearContents 'とびとびの場合
Intersect(r.EntireRow, Columns("N")).ClearContents
Intersect(r.EntireRow, Columns("P")).ClearContents
'Intersect(r.EntireRow, Columns("L:P")).ClearContents '連続の場合
End If
On Error GoTo 0
ありがとうございました。
おかげさまで今度はうまくゆきました。
ほかの質問の時のフォームと同じになったはずなので、そのときのデータ置き換え作業のVBAを流用して集計作業の方を試したら、これはだめでした。フォームが同じになったのにどうしてうまくゆかないのか、やはり素人考えでの流用はなかなかむつかしいですね。
とりあえず今回は希望する作業まで進むことができ感謝しています。
応用としてもしurlに変化があったときはyyyy-mm-ddの書式を直せばいいのですね。このyyyyはリアル日付で年を呼び込んでいるのでしょうか。たとえば
2010年のものをとりたいときはyyyyを文字列にしてしまえばいいですか?
またチャンネル部分が不要のときは、
「Dim sChan As Long~違うようです。", vbExclamation: Exit Sub」と
strURL = のところの「 & "&ch=" & CStr(sChan)」を削除すればいいですか?
もうひとつ行間をあける目安の「16:00/○○のパターン」が変わる場合は
「 Like "##:##?*"」を書き換えることになりますか?
セル削除
私も素人的に
Columns("A:A").SpecialCells(xlCellTypeBlanks).Offset(11).ClearContents
を12にしたり、14にしたりして何行か繰り返す記述をしていたのですが、とびとびだとやはり同じ理屈になってしまうのですね。連続の方は行を並べずに済むことができました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
「24日の0時」って・・・
-
日付の大小の表現
-
「時間」、「期日」、「日付」...
-
差し込み印刷に当日の日付が入...
-
回覧板の日付について質問です...
-
ACCESSで日付ごとに自動連番(...
-
Excelについて
-
履歴書の日付間違いで落ちますか。
-
エクセルで6ヵ月後を自動入力で...
-
フォームの値をクエリーに反映...
-
選択クエリで実行結果を非表示...
-
EXCELで日付を****年上期、****...
-
エクセルで日付別にシートを分...
-
Excelでヘッダに前日の日付を表...
-
WEEKDAYが反映されない
-
自己推薦書についてです! 自己...
-
Between関数とDateSerial関数の...
-
accessのフォームフィルタで 土...
-
ピボットテーブルの日付フィル...
-
Array関数のネスト
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
「24日の0時」って・・・
-
日付の大小の表現
-
「時間」、「期日」、「日付」...
-
回覧板の日付について質問です...
-
差し込み印刷に当日の日付が入...
-
履歴書の日付間違いで落ちますか。
-
エクセル マクロ 名前を付けて...
-
Excelについて
-
パソコンで購入したデーターが...
-
2つの日付の中間の日付 エク...
-
Excelでヘッダに前日の日付を表...
-
エクセルで日付け表示で、明治...
-
エクセルで日付別にシートを分...
-
Excelで1週間毎の集計(今週と...
-
エクセルで6ヵ月後を自動入力で...
-
マクロボタンを押すと、ファイ...
-
差込印刷 縦書きで和暦(漢数...
-
日付以外のデータを抽出したい...
-
EXCELで日付を****年上期、****...
-
Facebookで投稿日時を変更できない
おすすめ情報