IE6の表から最も赤い色をexcelに取り出したい

質問

1.環境 winxp pro sp2, office2003, ie6
2.やりたい事
下記URL　前日比欄の最も赤い コードと銘柄名 をexcelに取り出したい。
http://www.stockweather.co.jp/sw/ipo/performance.html
3.やった事
この画面→NOTEPADで編集→全てcopy→秀丸貼り付け→色情報が出る→この後？　*A
microsoft office wordで編集：遅いので使用せず
4.質問
*A　または　もっといい方法がありましたら教えてください。

回答No.1

Wendy02 · ベストアンサー

こんにちは。

表をみると、どうも、Web クエリで取れないような構造になっているようです。

一旦、ダミーのシートに、その株価情報を貼り付けて、次に、マクロで、ピックアップすればよいのではありませんか？

Sub CopyValues()
Dim Sh2 As Worksheet
Dim Rw As Long
Set Sh2 = Worksheets("Sheet2")
　Rw = ActiveCell.Row
　j = 1
　Application.ScreenUpdating = False
　For i = Rw To Cells(65536, 3).End(xlUp).Row
　　'前日比欄 が、１列目で、赤の場合
　　If Cells(i, 1).Interior.ColorIndex = 3 Then
　　　　'ここでは、2～6列のデータ5列分をシート2に送る*必要に応じて変えてください。
　　　 Sh2.Cells(j, 1).Resize(, 5).Value = Cells(i, 2).Resize(, 5).Value
　　　 j = j + 1
　　End If
　Next i
　Set Sh2 = Nothing
　Application.ScreenUpdating = True
End Sub

お礼

その後の調査結果です。
上記macroを組み込み実行した結果、sheet2に最も赤いコードと銘柄名ができました。
1.今後やるべき事
ファイル名、編集....の欄に、このmacro名を登録する。そうすれば、使い勝手が良くなります。
ありがとう御座いました。

補足

回答ありがとう御座います。
1.やった事
・excel sheetに前日比（色付き）、コード、銘柄名の表を作成しました。データのみ。
・上記macroを　aa.xls　として保存し、起動した。
・aa.xlsを起動しても、macroにならない。excelで開くのみです。
2.質問
macro初心者です。もう少し詳しく教えてください。

回答No.2

Wendy02

こんばんは。#1 のWendy02です。

>1.今後やるべき事
>ファイル名、編集....の欄に、このmacro名を登録する。そうすれば、使い勝手が良くなります。

「ファイル名、編集....の欄に、このmacro名を登録する。」
ちょっと、これは、面倒ですね。どうしても、というのでしたら、相談に乗りますが、それなりに、Excel全体に関わってきてしまいます。

今は、簡単な、マクロに手直して、コピーの送る側にコマンド・ボタンを付けられるように工夫してみました。

Sheet2 のほうを開いて、

表示(V) - ツールバー(T) - フォーム
　ボタン　(触っている、ポップアップで名前が現れる)

クリックして、ワークシートにおろすと、カーソルが「＋」に変わります。
適当なセルの上に確保して、ドラッグするとボタンが現れます。

そのままにしていると、次に、『マクロの登録』の窓が出てきますから、
　CopyValuesR　　　←新しいコード(以下のもの)

を探して、クリック
で、登録すればよいです。

もし、シート２側や他のシートに取り付けるとなると(#1のコードよりもこちらの方が確かです。)ただし、『前日比欄』は、必ず、１列目にあることが条件です。

貼り付け先は、『標準モジュール』側がよいです。

標準モジュールへの取り付け方
Alt　+　 F11 (Altを押しながらF11）を押すと、Visual Basic Editor 画面が出てきます。
次に、メニューの[挿入]－[標準モジュール]と開けて、クリックすると、画面が現れますので、以下のコードを貼り付けて、

Alt　+　Q で、画面を閉じます。

'------------------------------------------------

Sub CopyValuesR()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Rw As Long
Set Sh1 = Worksheets("Sheet1")　'データソース側
Set Sh2 = Worksheets("Sheet2")　'コピーの送り先
　j = 1
　Application.ScreenUpdating = False
　For i = 1 To Sh1.Cells(65536, 3).End(xlUp).Row
　　'前日比欄 が、１列目で、赤の場合
　　If Sh1.Cells(i, 1).Interior.ColorIndex = 3 Then
　　　　'ここでは、2～6列のデータ5列分をシート2に送る*必要に応じて変えてください。
　　　 Sh2.Cells(j, 1).Resize(, 5).Value = Sh1.Cells(i, 2).Resize(, 5).Value
　　　 j = j + 1
　　End If
　Next i
　Set Sh2 = Nothing
　Set Sh1 = Nothing
　Application.ScreenUpdating = True
End Sub

'------------------------------------------------

お礼

回答ありがとう御座いました。
1.>「ファイル名、編集....の欄に、このmacro名を登録する。」
ちょっと、これは、面倒ですね。どうしても、というのでしたら、相談に乗りますが、それなりに、Excel全体に関わってきてしまいます。
A:
今後、自分で検討してみます。
2.やった事
ご指摘頂いた事を全てやりました。できました。現状、これで十分です。満足しています。ありがとう御座いました。