- 締切済み
（VBAマクロ）複数月に渡る過去の天気の取得方法
webonerの回答
- weboner
- ベストアンサー率45% (111/244)
HPの作りが1ヶ月単位でしか表示できないようになっているので、翌月を指定して再度取り込みを実施するしかないですね
関連するQ&A
- オブジェクト変数またはWithブロック変数が設定されていません
はじめまして質問させていただきます。 Webページからコピー＆ペーストしたものを必要な情報だけ 抜き出すものを作成中です。 1ページ目は成功していますが 2ページ目の objIE.Navigate url の行で 実行時エラー'91' オブジェクト変数またはwithブロック変数が設定されていません。とでてしまします。 解決策をご教授お願いします。 Dim objIE As Object Dim url As String Dim tai As String Dim aku As String Dim uot As String Dim i As Integer Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True x = 1 For i = 1 To 20 url = Worksheets("データ").Range("E" & i) objIE.Navigate url Do If objIE.Busy = False And objIE.readyState = 4 Then Exit Do Loop objIE.ExecWB 17, 0 objIE.ExecWB 12, 0 Sheets.Add ActiveSheet.Name = "1" Range("A1").Select ActiveSheet.PasteSpecial Format:="テキスト" objIE.Quit: Set objIE = Nothing tai = Worksheets("1").Range("A13") aku = Worksheets("1").Range("A63") uot = Worksheets("1").Range("A64") Worksheets("データ").Select Range("A" & i) = tai Range("B" & i) = aku Range("C" & i) = uot Application.DisplayAlerts = False Worksheets("1").Delete Application.DisplayAlerts = True Next i
- ベストアンサー
- Visual Basic
- エクセルVBAで、IEからコピーするには
エクセル2000,win2000,IE6です。 次のような、コードを書きました。 Sub t03ccc() Dim objIE As Object 'IE オブジェクト参照用 Dim objShell As Object 'Shell オブジェクト参照用 Dim objWindow As Object 'Window オブジェクト参照用 Set objShell = CreateObject("Shell.Application") For Each objWindow In objShell.Windows '起動中のタイトルを探して。 If Left(objWindow.document.Title, 7) = "Office系" Then Set objIE = objWindow 'オブジェクトを代入 Msg = "Office系" Exit For End If Next If Msg <> "Office系" Then MsgBox "・・・スクリーニング結果一覧・・・がありません" Exit Sub End If objIE.ExecWB 17, 0 'OLECMDID_SELECTALL = 17 全てを選択 objIE.ExecWB 12, 0 'OLECMDID_COPY = 12 コピー Sheets("Sheet3").Select Rows("1:200").ClearContents Range("A1").Select ActiveSheet.Paste '''' objIE.Quit Set objIE = Nothing Set objShell = Nothing Set objWindow = Nothing End Sub これで、エクセルとIEしか開いてないときは巧くいくのですが、 エクスプローラーを同時に開くと実行時エラー438が出ます。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- EXCEL VBAで URLの内容 が取得できない
EXCEL VBA で VBAサンプルを参考にして、下記により、URLの内容を得ようとしていますが、できません。 どうも、URL画面の中に インプット用の記述があると、できなくなるのでは、と推測していますが、できるケースもあるようです。解決方法があるようでしたら、教えていただけますでしょうか？ (Win7 64B EXCEL2010 IE11です。)' Sub URL取得TEST() On Error GoTo Er1 Dim StrUrl As String StrUrl = InputBox("URLを指定", "URL入力", "http://www3.nhk.or.jp/nhkworld/") ' これは 読み込めます StrUrl = InputBox("URLを指定", "URL入力", "http://uwl.weblio.jp/") ' これが読み込めません Dim objIE As Object Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.FullScreen = False objIE.Top = 200 objIE.Left = 100 objIE.Width = 800 objIE.Height = 600 objIE.navigate StrUrl While (objIE.readyState <> 3 And objIE.readyState <> 4) Or objIE.busy = True DoEvents Wend DoEvents Workbooks.Add objIE.ExecWB 17, 0 objIE.ExecWB 12, 0 Sheets.Add ActiveSheet.name = "Format テキスト" Range("A1").Select ActiveSheet.PasteSpecial Format:="テキスト" objIE.ExecWB 17, 0 objIE.ExecWB 12, 0 Sheets.Add ActiveSheet.name = "FormatHTML" Range("A1").Select ActiveSheet.PasteSpecial Format:="HTML" '別のURLでテキストOKでこれはだめというケースあり ' objIE.Quit Set objIE = Nothing Exit Sub ' Er1: objIE.Quit Set objIE = Nothing End Sub
- ベストアンサー
- Visual Basic
- サイトタイトルを取得するマクロを最速化
下記のマクロは、サイトタイトルを取得するマクロです。 このマクロで、サイトタイトルを取得していましたが、 ５秒に１つくらいのペースなので、もっとスピードを上げたいと思っています。 最速化するには、どこか修正した方が良い箇所はあるでしょうか？ また、変更するべき設定などもあったりするでしょうか？ よろしくお願いいたします Sub sample() Dim Carea As Range Set Carea = Selection If Carea(1).Value = "" Then Exit Sub Dim Tcel As Range Dim ObjIE As Object Set ObjIE = CreateObject("InternetExplorer.Application") For Each Tcel In Carea ObjIE.Navigate Tcel.Value Do While ObjIE.Busy = True Or ObjIE.readyState <> 4 DoEvents Loop Tcel.Offset(, 1) = ObjIE.document.Title Next ObjIE.Quit Set ObjIE = Nothing End Sub
- 締切済み
- Visual Basic
- 【VBA】複数のブックを1つのシートにまとめる
あるフォルダ内に複数のブックが入っており、新しいブックに1シートでまとめようとしております。 フィルターを使用すればよいのかもしれませんが、マクロを使用したいです。 (1)全て同じフォーマットである (2)全てA17から数値が入力されているので、16行目まではフォーマットを残し、A17行目以降K列までをコピーして結合したい Sub 結合() '結合したいファイルがあるフォルダの場所 cドライブなら "C:\test\" Const Fol As String = "C:\test\" Dim Fn Dim NewFile As Workbook Dim Wb As Workbook Dim Ws1 As Worksheet Dim R As Range Set NewFile = Workbooks.Add Set Ws1 = NewFile.Worksheets(1) Set R = Ws1.Range("A17") Fn = Dir(Fol, vbNormal) Do Until Fn = "" Set Wb = Workbooks.Open(Fol & Fn) 'ワークシート1をコピーする場合は Wb.Worksheets(1) Set Ws1 = Wb.Worksheets(1) 'タイトル行を設定 If ck = False Then For cnt = 1 To 4 Wb.Worksheets(cnt).Range("A1:J16").Copy Destination:=NewFile.Worksheets(cnt).Range("A1") Next cnt ck = True End If For cnt = 1 To 4 Set Ws1 = NewFile.Worksheets(cnt) Set Ws2 = Wb.Worksheets(cnt) R = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1 With Ws2 End With Next 'A17行目からコピーして結合する（→本当はA17行目～K列までを反映したい) Ws2.Range("A17", Ws2.Cells(Rows.Count, 3).End(xlUp)).Resize(, 20).Copy R If R.Offset(1).Value = "" Then Set R = R.Offset(1) Else Set R = R.End(xlDown).Offset(1) End If Wb.Close 'Debug.Print Fn Fn = Dir Loop Set R = Nothing Set Ws1 = Nothing: Set Ws2 = Nothing Set Wb = Nothing: Set NewFile = Nothing End Sub マクロは触ったことない初心者でグーグル検索をしながら作ってみました。 一応実行するとエラーは出ないのですが、結合されたリストが飛び飛びで、理由がわかりません。 どなたかおわかりになりますでしょうか・・・。
- ベストアンサー
- Visual Basic
- エクセルのVBAで最終行までループする方法
エクセルのVBAで最終行までループする方法を教えてください。 下記がコードになります。 Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate Range("A1").Value While objIE.ReadyState <> 4 Or objIE.Busy = True DoEvents Wend Range("B1").value = objIE.Document.all("zoom1").href
- ベストアンサー
- オフィス系ソフト
- ＷＥＢ画面をエクセルのセルに貼り付けるマクロ
過去の回答を参考にエクセルでＷＥＢ画面をすべて選択しエクセルの所定のセルに貼り付けするマクロを作成しました。処理を追加していった結果、下記のようなマクロが完成しました。ステップインで動作確認できましたが、マクロ実行から動かすと途中で止まります。 止まる箇所は、 While objIE.readyState <> READYSTATE_COMPLETE Or objIE.Busy = True DoEvents Wend DoEvents この記述でＷＥＢが遅く開く時に対応するよう作成しましたが、ここで止まります。（抜け出せません） また、この記述を削るとステップインではうまく動きますが、マクロの実行から動かすと何回目かで objIE.ExecWB 17, 0 すべて選択するときに止まります。 どこが悪いのか教えていただけないでしょうか？ 使用、作成したのは、excel2007 及びexcel2010です。どちらでも動きません。 よろしくお願い致します。 Sub test() Dim URL As String Dim URL2 As String Dim URL3 As String Dim CD As String Dim i As Integer For i = 1 To 199 CD = Worksheets("CD").Cells(i + 1, 1).Value URL2 = "貼り付けたいＷＥＢのＵＲＬ" URL3 = CD ’縦一列にコードを入力しているシート URL = URL2 & URL3 Dim objIE As Object Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.navigate URL While objIE.readyState <> READYSTATE_COMPLETE Or objIE.Busy = True DoEvents Wend DoEvents objIE.ExecWB 17, 0 objIE.ExecWB 12, 0 Sheets.Add ActiveSheet.Name = 199 - i Range("A1").Select ActiveSheet.PasteSpecial Format:="HTML" objIE.Quit Set objIE = Nothing Next End Sub よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
- エクセルマクロ 検索して値を取得
マクロはよく分かっていません。 既存のVBAを見ながらマネしてる状態なので、どこが間違っているのか教えて下さい。 sheet1 A 所属 1 789 2 3 sheet2 A B 所属コード 所属 1 12345 あいう123 2 12346 あいう456 3 12347 あいう789 やりたいこと シート１の所属が「789」だったらとシート２の所属から「あいう789」を検索し、シート２の所属コード「12347」をシート１の所属に返す。 私が作ったやつだと「12347」は１行目でなく、３行目に返ってしまいます。 Dim SyozokuRange as Range Dim Syozoku as String Dim Buf as String Buf = "あいう" Syozoku = Buf & Syozoku Set SyozokuRange = worksheets(2).range("a:b").currentregion For i = 1 to SyozokuRange.rows.count If Syozoku = SyozokuRange.cells(i,2) Then worksheets(1).cells(i,1).value = SyozokuRange.cells(i,1) end if next i
- 締切済み
- オフィス系ソフト
- サイトのページの全体をコピーしてエクセルに貼り付け
サイトのページの全体をコピーしてエクセルに貼り付けたいのですが http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1341770528 を参考にしたのですが Sub test() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "http://www.goo.ne.jp/" While objIE.ReadyState <> 4 DoEvents Wend objIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT '17,0 objIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT '12 DoEvents Workbooks.Add DoEvents Range("A1").Select ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, DisplayAsIcon:=False End Sub をしたのですが、うまくコピーできていません。 一番最後にコピーした文字がセルに張りついてしまいます。 なぜでしょうか？
- ベストアンサー
- その他MS Office製品
- VBAの比較削除マクロ
Sheet1とSheet2のB列を参照して同じ値が存在する場合は、Sheet1の行を削除するマクロを作成したいのですがどのように記述したらよいか分かりません。 Sheet1とSheet2のB列を参照して同じ値が存在する場合は、Sheet3にSheet1の行をコピーするマクロはホームページ等を参照して下記のように記述できました。 Public Sub copy() Dim tempRange As Range Dim fax1Table As Range Dim fax2Table As Range Dim dst As Range Dim FoundCell As Range 'fax1範囲指定 Worksheets("Fax1").Activate Set fax1Table = Range("a1").CurrentRegion Set fax1Table = fax1Table.Offset(1) Set fax1Table = fax1Table.Resize(fax1Table.Rows.Count - 1) 'fax2範囲指定 Worksheets("Fax2").Activate Set fax2Table = Range("a1").CurrentRegion Set fax2Table = fax2Table.Offset(1) Set fax2Table = fax2Table.Resize(fax2Table.Rows.Count - 1) '比較開始 Worksheets("fax1").Activate '見出しコピー Set dst = Worksheets("fax3").Range("a1") Range("a1:ad1").copy dst 'レコード抽出 For Each tempRange In fax1Table.Rows Set FoundCell = fax2Table.Columns(2).Find(tempRange.Columns(2).Value, , xlValues, xlWhole) If Not FoundCell Is Nothing Then Set dst = dst.Offset(1) tempRange.copy dst End If Next tempRange '比較終了 'セル幅自動調整 Worksheets("fax3").Range("a:g").Columns.AutoFit Worksheets("fax3").Activate End Sub
- ベストアンサー
- その他MS Office製品
お礼
ご回答ありがとうございます。 ２ヶ月、３ヶ月を別のセルで指定して指定月まで繰り返すような形にしたいという思いがあったのですが、言葉足らずで説明不足でした。 貴重なお時間をありがとうございました。