エクセルシート1にWEBページの文字列貼付け⇒その『リンク』をシート2にもコピーする関数

EXCELについてお尋ねします。

例えば、YAHOOのトップページを開くと、真ん中にニュースの見出しが表示され、その見出しはクリックできる青文字で表示されており、そのタイトルをクリックすると、ニュース詳細ページに飛びます。

このタイトルの1～8行目までの文字列をドラッグしてコピーし、EXCELの「Sheet1」の「A1セル」に貼り付けると、A1～A8セルまでに8行のニュースタイトルが並び、このタイトルは青文字で表示されていて、それをクリックするとブラウザーが立ち上がり、そのニュース詳細が表示されますよね？

このハイパーリンクが自動的にSheet2のA1～A8セルにコピーされ、Sheet2のA1~A8セルのいずれかをクリックすると、そのニュース詳細ページに飛ぶようにしたいのですが、どういった関数を使用すれば良いのでしょうか？

単純にSheet1のA1～A8セルをコピーして、Sheet2のA1セルに貼り付ければ済むのですが、上記のヤフーニュースは単なる例でして、実際はSheet1はWEBページの文字列をコピーして貼り付けるだけの貼付け専用シートとし、その中の文字列をSheet２に抜き出して表を作っている為、一度のコピーペーストで済むようにしたいのです。

ご回答よろしくお願い致します。

No.3 ベストアンサー 回答者： tom04 回答日時： 2015/04/04 22:49

続けてお邪魔します。

＞マクロで行う場合で、Sheet2のC3～C50にのみその操作を行いたい場合、教えて頂いたコードのどの部分を変更する必要がありますでしょうか？

今までのコード（これから提示するコード）はSheet1のセルのデータ変更があった場合に
実行されるコードですので、Sheet2の設定は何も必要ありません。

結局Sheet1のC3～C50セルデータ変更時のみのコードで良いと思いますので、
↓のコードに変更してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) '//この行から
Dim c As Range
'//対象セルが　C3:C50　以外ならなにもしない
If Intersect(Target, Range("C:C")) Is Nothing Or Target.Count > 100 Then Exit Sub
Application.ScreenUpdating = False
For Each c In Target
If c.Row >= 3 And c.Row <= 50 Then
'//対象セルをSheet2の同じセル番地にコピー＆ペースト
c.Copy
Worksheets("Sheet2").Cells(c.Row, "C").PasteSpecial Paste:=xlPasteAll
End If
Next c
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub '//この行まで

※　No.1で書いたように、Sheet1のシートモジュールですので
画面左下、Sheet見出しの「Sheet1」上で右クリック　→　・・・中略（No.1の操作）・・・として
Sheet1のデータを変更するだけです。

※　書式のみの変更では何も反応はしません。
データ変更があった場合のみマクロが実行されます。m(_ _)m

この回答へのお礼

お忙しい中何度もご親切にありがとうございます★
理解するのはちょっと時間がかかりそうですが、そのままコピーしてやってみようと思います。
本当にありがとうございました(^^)

お礼日時：2015/04/04 23:04

No.2 回答者： tom04 回答日時： 2015/04/04 21:02

No.1です。

＞関数で代用は難しいでしょうか？

仮に、Sheet2のA1セルに
=IF(Sheet1!A1="","",Sheet1!A1)
という数式を入れておき、列・行方向にこれ以上データはない！という位まで
フィル＆コピーしておけばとりあえずはSheet1のデータは表示されます。
ただし、関数で返る結果はあくまで「値」になりますので、
今回のようにハイパーリンクの設定をそのまま関数で！となると難しいと思います。

やはりVBAになってしまうのではないでしょうかねぇ～
A列だけでなくセル位置はランダムだというコトですので、
前回同様の操作で↓のコードに変更してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) '//この行から
Dim c As Range, str As String
If Target.Count > 1000 Then Exit Sub '//←極端に範囲が広い場合は実行しない（1000程度までとしている）
Application.ScreenUpdating = False
For Each c In Target
str = c.Address(False, False)
c.Copy
Worksheets("Sheet2").Range(str).PasteSpecial Paste:=xlPasteAll
Next c
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub '//この行まで

※　関数でできる方法があればごめんなさいね。m(_ _)m

この回答へのお礼

ご親切に2度もご回答ありがとうございます★
マクロが使えるなんてカッコいいなぁと尊敬してしまいます。

マクロの基礎知識が全く無いもので、正直チンプンカンプンです…(笑)
前回教えて頂いたコードと今回のコードはどういう違いがあるのでしょうか？

＞A列だけでなくセル位置はランダム

私の説明が間違ってました。
ランダムではなく、sheet2のC3セルからそのままC50セルまでの一列です。
その為、関数をC3セルに入力して、そのままフィルハンドルで下までドラッグすればいいかなぁと考えておりましたが、関数では難しいのですね…

マクロで行う場合で、Sheet2のC3～C50にのみその操作を行いたい場合、教えて頂いたコードのどの部分を変更する必要がありますでしょうか？

また、教えて頂いたコードを貼り付けて、その後何か操作は必要でしょうか？

あまりに基本的な質問ですみません。
今までにも何度かマクロの使い方が書かれたサイトは読んだのですが、結局理解出来ず断念してしまいました…
もしお手すきのお時間がございましたら教えて頂けると有難いです。
どうぞよろしくお願い致します。

お礼日時：2015/04/04 21:51

No.1 回答者： tom04 回答日時： 2015/04/04 20:19

こんばんは！

手っ取り早くVBAでの一例です。

画面左下のSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り
質問にある操作を行ってみてください。

Private Sub Worksheet_Change(ByVal Target As Range) '//この行から
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Range("A:A").Copy Worksheets("Sheet2").Range("A1")
End Sub '//この行まで

※　単純に手作業をコードにしただけです。m(_ _)m

この回答へのお礼

早速のご回答ありがとうございます(^^)

エクセルは初歩的な事しかわからないレベルでマクロは全く使ったことがないもので…
今回は伝わりやすいようにA1セルでとお伝えしたのですが、実際はセル位置も異なりますし、どう変更したらいいのかがさっぱりわかりません。

出来ましたら関数で代用は難しいでしょうか？

お礼日時：2015/04/04 20:32