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

回答の条件
  • 1人5回まで
  • 登録:2009/08/24 13:16:41
  • 終了:2009/08/26 12:41:33

ベストアンサー

id:HALSPECIAL No.1

HALSPECIAL回答回数407ベストアンサー獲得回数862009/08/26 09:45:08

ポイント1000pt

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

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の部分は、他の回答者を募るか、自力で実装してみてください。^^;

id:tororosoba

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

2009/08/26 12:40:58
  • id:HALSPECIAL
    HALSPECIAL 2009/08/26 14:46:11
    たくさんのポイントありがとうございます。
    完全回答でないのにすみません。
    おかげさまで、もうちょっとでラジコンが買えそうです。
  • id:HALSPECIAL
    HALSPECIAL 2009/08/30 01:25:43
    暇だったのでこちらに自動化したものを置きました。
    しばらくしたら消すかもしれません。
    http://d.hatena.ne.jp/HALSPECIAL/20090829
    試してみてください。
  • id:tororosoba
    HALSPECIALさん、すみません、使用することに夢中になっていて、こちらのコメントに気づきませんでした。わざわざ有難うございました!感謝です!

この質問への反応(ブックマークコメント)

トラックバック

  • 自動化しました ウェブ上のデータダウンロードのマクロ作成をお願いします。もしそのまま使える完全な回答をしていただいた最初の回答者の方に、お気持ちですが1000ポイント差し上げま
  • 自動化しました ウェブ上のデータダウンロードのマクロ作成をお願いします。もしそのまま使える完全な回答をしていただいた最初の回答者の方に、お気持ちですが1000ポイント差し上げま
「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません