Ｐａｇｅ 454 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼ﾘﾝｸﾌｧｲﾙのﾃﾞｰﾀの自動読込 困っているおじさん 02/12/4(水) 9:57 ┗Re:ﾘﾝｸﾌｧｲﾙのﾃﾞｰﾀの自動読込 こうちゃん 02/12/5(木) 10:50 ┗Re:ﾘﾝｸﾌｧｲﾙのﾃﾞｰﾀの自動読込 困っているおじさん 02/12/6(金) 10:31 ┗なんででしょうね こうちゃん 02/12/6(金) 13:01 ┗Re:なんででしょうね 困っているおじさん 02/12/13(金) 11:00 ─────────────────────────────────────── ■題名 ： ﾘﾝｸﾌｧｲﾙのﾃﾞｰﾀの自動読込 ■名前 ： 困っているおじさん ■日付 ： 02/12/4(水) 9:57 -------------------------------------------------------------------------
| 複数のファイルで階層型の集計表を作りました。 マスター集計表は以下のような構造です。 Ａ列 ｜ Ｂ列 〜 Ｈ列 ------------------------------------------------------------------------- ﾃﾞｰﾀﾌｧｲﾙ1.（ﾊｲﾊﾟｰﾘﾝｸ）｜ﾃﾞｰﾀﾌｧｲﾙ1.の”ﾃﾞｰﾀ”ｼｰﾄの特定のセルの値ﾘﾝｸ ﾃﾞｰﾀﾌｧｲﾙ2.（ﾊｲﾊﾟｰﾘﾝｸ）｜ﾃﾞｰﾀﾌｧｲﾙ2.の”ﾃﾞｰﾀ”ｼｰﾄの 〃（セル番地↑と同じ） 〜 〜 ﾃﾞｰﾀﾌｧｲﾙx（=100） |ﾃﾞｰﾀﾌｧｲﾙxの ”ﾃﾞｰﾀ”ｼｰﾄの 〃（セル番地↑と同じ） ↑ ﾘﾝｸを手動ではっており、作業が大変(;;) <改善したい点> （Ａｘ）セルに「ﾃﾞｰﾀﾌｧｲﾙｘ」をハイパーリンクしたら、（Ｂｘ）〜(Ｈｘ）セルの リンクを自動化するマクロを組みたいのです。 補足：ﾃﾞｰﾀﾌｧｲﾙ名は、それぞれ異なります ﾃﾞｰﾀﾌｧｲﾙは毎月継ぎ足されます（過去分は残ります） |
| 困っているおじさん さん、こんにちは レスがつかないようなので、ある程度想定で回答します。 ><改善したい点> >（Ａｘ）セルに「ﾃﾞｰﾀﾌｧｲﾙｘ」をハイパーリンクしたら、（Ｂｘ）〜(Ｈｘ）セルの >リンクを自動化するマクロを組みたいのです。 「ハイパーリンクしたら」は難しいので全シート対象としました。 B列に計算式が設定されていなければ、B〜H列に計算式を設定します。 ＃「セル番地↑と同じ」の意味がわかりませんでしたので、対象ブックの自セルと同じアドレスとして計算式を設定しています。適当に変えてください。 （標準モジュールで試験してみてください） Option Explicit Sub test() Dim HL As Hyperlink Dim MaxRow As Long Dim i As Long Dim j As Integer Dim TmpAddress As String Worksheets(1).Select '最大行数取得 MaxRow = Range("A65536").End(xlUp).Row For i = 1 To MaxRow '計算式の設定されていないセルだけ設定 If Cells(i, 2).Formula = "" Then TmpAddress = "" 'ハイパーリンクコレクションの検索 For Each HL In Worksheets(1).Hyperlinks 'ハイパーリンクコレクションからA列の該当アドレス検索 If HL.Range.Address = Cells(i, 1).Address Then TmpAddress = HL.Address Exit For End If Next If TmpAddress <> "" Then '計算式文字列作成 TmpAddress = SetAddress(TmpAddress) 'B列からH列まで計算式設定 For j = 2 To 8 Cells(i, j).Formula = "=" & _ TmpAddress & Cells(i, j).Address Next End If End If Next End Sub Function SetAddress(Temp As String) As String '計算式Sheet参照文字列作成関数 '注意：当方の環境で試験するため対象シートをSheet1として設定しています。 '実際には"ﾃﾞｰﾀ"シートに変更してください。 Dim LeftAddress As String Dim RightAddress As String LeftAddress = "" RightAddress = "" If InStr(Temp, "\") Then LeftAddress = Left(Temp, InStrRev(Temp, "\")) RightAddress = Right(Temp, Len(Temp) - _ Len(LeftAddress)) Else RightAddress = Temp End If SetAddress = "'" & LeftAddress & _ "[" & RightAddress & "]Sheet1'!" End Function |
| ▼こうちゃん さん： 説明不足な質問にもかかわらず的確な御回答ありがとうございました。 昨日、回答をいただき それなりに理解するのに半日＾＾ 試して確認するのに半日＾＾ プログラムは思い描いていたとおりの動作をしてくれます。 現在実際の集計表に合わせて、修正しているところです。 一つだけ不安定な動作をします。 下記の関数でハイパーリンク先のアドレスを読み込み結果が 1.になるべきが、2.や3.になることがあります。 使い方が悪いのでしょうか? 1. \\SS00\×××\△△△\□□□\〜〜\[***]WWW！$D$X 2. \\SS00\×××\△△△\□□□\□□□\〜〜\[***]WWW！$D$X 3. C:\Documents and Settings\〜〜\[***]www!$D$X Function SetAddress(Temp As String) As String '計算式Sheet参照文字列作成関数 Dim LeftAddress As String Dim RightAddress As String LeftAddress = "" RightAddress = "" If InStr(Temp, "\") Then LeftAddress = Left(Temp, InStrRev(Temp, "\")) RightAddress = Right(Temp, Len(Temp) - _ Len(LeftAddress)) Else RightAddress = Temp End If |
| 困っているおじさん さん、こんにちは >一つだけ不安定な動作をします。 >下記の関数でハイパーリンク先のアドレスを読み込み結果が >1.になるべきが、2.や3.になることがあります。 >使い方が悪いのでしょうか? > >1. \\SS00\×××\△△△\□□□\〜〜\[***]WWW！$D$X >2. \\SS00\×××\△△△\□□□\□□□\〜〜\[***]WWW！$D$X >3. C:\Documents and Settings\〜〜\[***]www!$D$X InStrRevで最後の\の位置がとれていないのかなぁ〜？ Function SetAddressの最初のほうにブレークポイントを設定して、渡されたTempの値とLeftAddress、RightAddress の値の変化を確認してみていただけますか？ 2.のようになる原因はわからないのですが、3.はありうるかもしれませんね。 最初にハイパーリンクを設定する際に C:\**\××\○○\WWW.XLS のように指定しても、エクセル側でWWW.XLSのように変更してしまうことがあります。 （同名のファイルが開いていたり、既定のフォルダにあったりすると） 共有名の場合は確認していませんが、そのへんは考えられるかも。 ＃私の方でも、共有名で試験してみますが、きょうは時間がないので、月曜以降ということになってしまいます。すみません。 |
| ▼こうちゃん さん： いろいろと御教授ありがとうございました。 あれ以来、試行錯誤を繰り返しましたが、”TEMP”のパスは どうしても常時フルパスを取得できません。 ハイパーリンクを設定直後は、 \\○○\□□\〜 \△△\[***]！$D$9 --- 1. と返されるのですが、ファイルをクローズして再立ち上げした後などは、 ..\△△\[***]!$D$9 --- 2. と、セルに表示されたそのままのパスが返されます。 幸い、\\△△ より上位のパスは同一なので、2.の用な状態のときは 強制的に、パスを書き込み フルパスになるようにしました。 スマートとは言えませんが、こんな状態でも実用上問題はないので 使っています。 以前手動でリンクを貼ってもらっていた担当者からは、喜ばれています＾＾ 初めてのマクロで何も分からない状態でしたが､何とか動くようになったのも 適切な御指導の賜物です。本当にありがとうございました。 遅くなりましたが、御礼申し上げます <(_ _)> |