人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

ウェブ上のデータダウンロードのマクロ作成をお願いします。もしそのまま使える完全な回答をしていただいた最初の回答者の方に、お気持ちですが1000ポイント差し上げます。宜しくお願いいたします。具体的にはこちらのサイトです。(http://isin.krx.co.kr/)ダウンロードページへは、トップメニュー(背景が青の部分)の左から二項目の、上から3つ目のリンクです(7文字)です。?リンク先のフォームにある、上から4項目のフィールド2つ共に常時本日の日付を入力。?その下の項目の左から6番目のチェックボックスにチェックを入れる(CDの左隣)??で日付を入れた横にあるボタンをクリック。ここで検索結果が数ページに渡り抽出されますので、一番左のコラムにある青字12桁コードのリンク先のポップアップページに表示される表データをエクセルシート1の7行目以下に順々に読み込むプロセスを是非自動化したいです(1コードに対して4コラム使用し、二つ目のコードのデータはE7から開始)。現在、マニュアルでコピペしています。是非ご協力頂ければと思います。


●質問者: tororosoba
●カテゴリ:コンピュータ
✍キーワード:ウェブ エクセル クリック コピペ コラム
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● HALSPECIAL
●1000ポイント ベストアンサー

完全な回答でなく、半自動くらいのマクロです。

WEBクエリを使用してみました。

1.プログラムソースを標準モジュールに貼り付けます。

2.シートのA1セル、A2セル、A3セル、・・・

に一覧で表示された発行コード?(KRA553210W90等)を貼り付けます。

この部分が手作業になります。

3.Main 関数を実行すると、シートに結果が貼り付けられていきます。

Main 関数は適宜、ボタンなどに割りつけてください。


Option Explicit


Private Const WEBTABELS As String = "3" 'WEBクエリの取込み項目の指定
Private Const PASTE_ROW As Integer = 1 '貼り付け開始行
Private Const PASTE_COL As Integer = 2 '貼り付け開始列
Private Const WEBFORMATTING As Integer = xlWebFormattingRTF '取込みの種類(xlWebFormattingRTF:書式付、xlWebFormattingNone:テキストのみ)
Private Const URL_BASE As String = "http://isin.krx.co.kr/jsp/BA_VW021.jsp?isu_cd={0}&modi=t&req_no={1}"


Public Sub Main()
 'request sample
 'http://isin.krx.co.kr/jsp/BA_VW021.jsp?isu_cd=KRA553210W90&modi=t&req_no=200908250012"
 'http://isin.krx.co.kr/jsp/BA_VW021.jsp?isu_cd=KRA553210W90&modi=t&req_no=200908250012
 
 Dim isu_cd As String
 Dim req_no As String
 Dim url As String
 Dim col As Integer
 
 col = PASTE_COL
 Cells(1, 1).Activate
 
 Do Until ActiveCell.Value = ""
 url = URL_BASE
 isu_cd = ActiveCell.Value
 req_no = Format(Now, "yyyymmddhhnnss")
 url = Replace(url, "{0}", isu_cd)
 url = Replace(url, "{1}", req_no)
 Call GetWebData(url, Cells(PASTE_ROW, col))
 ActiveCell.Offset(1, 0).Activate
 col = col + 4
 Loop
 
 Cells(1, 1).Activate

 MsgBox "おわり", vbInformation

End Sub


Sub GetWebData(ByVal url As String, ByVal startCell As Range)
 With ActiveSheet.QueryTables.Add(Connection:="URL;" & url, Destination:=startCell)
 .RefreshStyle = xlOverwriteCells
 .Refresh BackgroundQuery:=False
 .AdjustColumnWidth = False
 .WebSelectionType = xlSpecifiedTables
 .WEBFORMATTING = xlWebFormattingRTF 'xlWebFormattingNone
 .WebTables = WEBTABELS
 End With
End Sub

※excel2007で動作確認しました。

※取得内容は正しいかどうかわかりません。

※完全な回答は人力の回答というより仕事の部類に入ってしまうので、

すみませんが、ここまでしか回答できませんでした。

※2の部分は、他の回答者を募るか、自力で実装してみてください。^^;

◎質問者からの返答

HALSPECIALさん、確認させていただきました。いつも本当に有難うございます!コピペの回数がこれで激減しますので、非常に助かります。今後ともどうぞ宜しくお願いいたします。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ