エクセルVBAでシート内の参照セルを画面上の左上に持ってくる方法

このQ&Aのポイント
  • エクセルVBAを使用して、各シート内の参照セルを画面上の左上に持ってくる方法を知りたいです。
  • 他の人の質問を参考にして、エクセルVBAを使って各シート内の参照セルを画面上の左上に表示する方法を習得しました。
  • ハイパーリンクをクリックすると、そのセルが画面上の左上に表示されるようにしたいです。
回答を見る
  • ベストアンサー

エクセルVBA thisworkbookで

他の方のQ&Aを参照し、以下のことが出来るようになりました。 各シートに記述し、ハイパーリンクをクリックした際、同シート内の参照セルを、画面上の左上に持ってくるというものです。 http://oshiete1.goo.ne.jp/qa631706.html Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) Dim ww_j As Long, ww_k As Long ww_j = ActiveCell.Row() ww_k = ActiveCell.Column() ActiveWindow.ScrollRow = ww_j '行 ActiveWindow.ScrollColumn = ww_k '列 End Sub ここからですが、シートが複数あるため、できれば同ブック内で使用したいと考えております。 thisworkbookに記載すればよいかと思ったのですが、うまくいきませんでした。 どのようにすれば、1シートにみではなく、1ブック内で使用できるか、お教えくださいますようお願い申し上げます。

質問者が選んだベストアンサー

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

thisworkbookに記載するなら以下のようにしてみてください。 × Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) ○ Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) ↓ Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) Dim ww_j As Long, ww_k As Long ww_j = ActiveCell.Row() ww_k = ActiveCell.Column() ActiveWindow.ScrollRow = ww_j '行 ActiveWindow.ScrollColumn = ww_k '列 End Sub

yukiko5
質問者

お礼

ありがとうございました。できました。 Workbook_Sheet の意味 ByVal Sh As Object, の意味も、 正しい答えをお教えいただいたので、すぐに他サイトで確認し、わかりました。 ありがとうございました。

関連するQ&A

  • excel vba ジャンプ

    excel2003のUserFormにてtextbox作成しました。 textbox1にページを入力すると指定のページにジャンプする コードを作成したのですが、動作的には目的とする事ができました。 ただ、初心者レベルで作成したので、コード記述が長く、 ページが増えるたびにコードを追記していかなければなりません。 下記に作成したコードを記述します。 もっと簡単に記述する方法はありますか? ---------------------------------------------------------- Private Sub TextBox1_Change() If TextBox1.Value = 1 Then ActiveWindow.ScrollRow = 1 ActiveWindow.ScrollColumn = 1 Range("$A$15").Select End If If TextBox1.Value = 2 Then ActiveWindow.ScrollRow = 38 ActiveWindow.ScrollColumn = 1 Range("$A$38").Select End If If TextBox1.Value = 3 Then ActiveWindow.ScrollRow = 69 ActiveWindow.ScrollColumn = 1 Range("$A$69").Select End If If TextBox1.Value = 4 Then ActiveWindow.ScrollRow = 100 ActiveWindow.ScrollColumn = 1 Range("$A$100").Select End If If TextBox1.Value = 5 Then ActiveWindow.ScrollRow = 131 ActiveWindow.ScrollColumn = 1 Range("$A$131").Select End If End Sub ---------------------------------------------------------- 上記記述で行っていることは、 textbox1に 1 と入力すると1ページ目が表示  キーボードでctrl+Homeの操作をした状態でカーソルがA15選択 textbox1に 2 と入力すると2ページ目が表示  表示の先頭が38行目、カーソルがA38選択 ページの行数が1ページ目だけ37行 2ページ目以降が31行ごとです。 実際は、200ページ以上あるのでなんとかしたいのですが・・・・

  • またまたEXCELmacroについて

    お世話になります。 EXCEL 2016にて 或る表に対して以下のようなmacroを組みました。 動きは思った通りに動いてくれるので問題無いのですが、繰り返しが意外に多くなってしまい、もっとうまいまとめ方が有るように思えてきました。 Select Case 文をまとめるか、別Procにするかで悩んでいます。よろしかったらアドバイスをお願いします。 ---------------------------------------------------------------------- Sub seikatsu() With ActiveWindow If ActiveCell.Column > 5 And ActiveCell.Column < 37 Then Select Case ActiveCell.Row Case 4 To 29 .ScrollRow = 4 .ScrollColumn = 6 Case 37 To 62 .ScrollRow = 37 .ScrollColumn = 6 End Select ElseIf ActiveCell.Column > 43 And ActiveCell.Column < 51 Then Select Case ActiveCell.Row Case 4 To 29 .ScrollRow = 4 .ScrollColumn = 44 Case 37 To 62 .ScrollRow = 37 .ScrollColumn = 44 End Select ElseIf ActiveCell.Column > 54 And ActiveCell.Column < 62 Then Select Case ActiveCell.Row Case 4 To 29 .ScrollRow = 4 .ScrollColumn = 55 Case 37 To 62 .ScrollRow = 37 .ScrollColumn = 55 End Select ElseIf ActiveCell.Column > 65 And ActiveCell.Column < 80 Then Select Case ActiveCell.Row Case 4 To 29 .ScrollRow = 4 .ScrollColumn = 66 Case 37 To 62 .ScrollRow = 37 .ScrollColumn = 66 End Select Else Select Case ActiveCell.Row Case 4 To 29 .ScrollRow = 4 .ScrollColumn = 6 Case 37 To 62 .ScrollRow = 37 .ScrollColumn = 6 End Select End If End With End Sub ---------------------------------------------------------------------- なお、VBAではインデント指定していますが、ここではベタ打ちのようになってしまいます。ご容赦下さい。よろしくお願いします。

  • エクセル VBA 繰り返し処理を 簡潔にしたいのでお願いします。

    初心者です。繰り返し処理のシート名操作が分かりません。 上手く説明できないのですが、シートの名前が数字の1~20で 特定のセルを参照してテーブルにします。 現在、とても単純なコードを繰り返しています。 すっきりとさせるには、どのように記載するとよいのか 教えてください。 以下の処理を20回ほど繰り返します。  'シート1の特定セルをコピーします Sheets("1").Range("c3").Copy Range("A3").PasteSpecial Sheets("1").Range("c4").Copy Range("B3").PasteSpecial Sheets("1").Range("o2").Copy Range("C3").PasteSpecial Sheets("1").Range("o3").Copy Range("D3").PasteSpecial Sheets("1").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E3").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True 'シート2の特定セルをコピーします Sheets("2").Range("c3").Copy Range("A4").PasteSpecial Sheets("2").Range("c4").Copy Range("B4").PasteSpecial Sheets("2").Range("o2").Copy Range("c4").PasteSpecial Sheets("2").Range("o3").Copy Range("d4").PasteSpecial Sheets("2").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets("3").Range("c3").Copy Range("A5").PasteSpecial Sheets("3").Range("c4").Copy Range("B5").PasteSpecial Sheets("3").Range("o2").Copy Range("c5").PasteSpecial Sheets("3").Range("o3").Copy Range("d5").PasteSpecial Sheets("3").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E5").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True

  • エクセルマクロでオートフィルタを貼り付け。VBA

    お世話になっております。 エクセルのマクロを作成したのですが、上手く機能いたしません。 オートフィルタで条件に一致するものが現在表示されている 「CSV元データをここに貼り付ける」という名前のシートが ございます。 これをシートを全選択し、そのまま 「加工1」という名前のシートに貼り付ける。 といったマクロを作成したのですが、加工1には何も貼り付けられていないようです。 下記にマクロのプログラムを記載しますので、どこを訂正すればいいのかをお教えいただければ ありがたいです。 無知で申し訳ございませんが、何卒よろしく御願いいたします。 当方が今したいのは、マクロ2なのですが、マクロ2を見ようとするとマクロ1も表示されます。 なぜ、マクロ1もでてくるのかわかりませんが、よろしく御願いいたします。 Sub マクロ1() ' ' マクロ1 Macro ' マクロ記録日 : 2011/10/31 ユーザー名 : ' ' Columns("A:D").Select Selection.Delete Shift:=xlToLeft Columns("D:D").Select Sheets("読込データ(加工1)").Select ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Sheets("読込データ(ORG)").Select ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 11 Sheets("csv元データをここに貼り付ける").Select Columns("B:D").Select Selection.Delete Shift:=xlToLeft Columns("I:P").Select Selection.Delete Shift:=xlToLeft Range("I19").Select Sheets("csv元データをここに貼り付ける").Select Rows("2:2").Select Selection.AutoFilter Selection.AutoFilter Field:=9, Criteria1:="=2", Operator:=xlAnd End Sub Sub マクロ2() ' ' マクロ2 Macro ' マクロ記録日 : 2011/10/31 ユーザー名 : ' ' Cells.Select Selection.Copy Sheets("加工1").Select Range("G12").Select End Sub

  • エクセル2003でダブルクリック処理でエラーをしてしまう

    エクセルのシートAからZまであります 一部計算式が入っているのデーター処理が終了後に ダブルクリックでコピー&値の貼り付けで式をなくしていますが 列の一部とフィルターをかけると処理ができずにエラーをしてしまい 対処方法が分かりません 初心者でエラーの意味すら分からないのですが選択した領域と 貼り付ける領域が違うようなのです どこを直せばよいのか教えて下さい。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim RangeName As String RangeName = Target.Address RangeName = Mid(RangeName, 2, 1) If RangeName = "Z" And Target = "" Then Target = "OK" Range(Cells(Target.Row, 1), Cells(Target.Row, 27)).Copy ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range(Cells(Target.Row, 1), Cells(Target.Row, 27)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 End If End Sub 宜しくお願いします。

  • マクロ【全体指定】

    御世話になります。 下記のマクロコードをあるエクセルファイルの全シート指定で一括処理したいのですが、可能でしょうか? Sub test() 行番号 = 1 ActiveWindow.ScrollRow = 行番号 列番号 = 1 ActiveWindow.ScrollColumn = 列番号 End Sub かなり初歩的な質問で申し訳ありませんが、宜しくお願い致します。

  • excel2010 簡単にするコード

    Sub 問10SUM() ' ' 問10SUM Macro ' Range("B1007").Select ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)" Range("B1007").Select Selection.AutoFill Destination:=Range("B1007:AW1007"), Type:=xlFillDefault Range("B1007:AW1007").Select Range("AW994").Select ActiveCell.FormulaR1C1 = "=SUM(RC[-47]:RC[-1])" Range("AW994").Select Selection.AutoFill Destination:=Range("AW994:AW1007"), Type:=xlFillDefault Range("AW994:AW1007").Select ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 19 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("B1020").Select ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)" Range("B1020").Select Selection.AutoFill Destination:=Range("B1020:AW1020"), Type:=xlFillDefault Range("B1020:AW1020").Select Range("AW1011").Select ActiveCell.FormulaR1C1 = "=SUM(RC[-47]:RC[-1])" Range("AW1011").Select Selection.AutoFill Destination:=Range("AW1011:AW1020"), Type:=xlFillDefault Range("AW1011:AW1020").Select ActiveWindow.ScrollColumn = 22 ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 End Sub これはマクロの記録で作ったものです。AWにオートサムでBからAVを選択して右下の+を下に引っぱりました。。 ドラッグして選択せずにすむコード、もっと短くする方法を教えてください。 ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー      A     B    中略   AV     AW 993行  ラベル  北海   ~     沖     合計 994行  魚    2    ~     9     1100 中略  1006行  他    6    ~     空欄    2000 ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー 簡単に載せると表はこうなっています。

  • エクセルVBAでCSV読み込みについて質問します。

    エクセルVBAでCSV読み込みについて質問します。 外部データの取り込みマクロを自動記録で作成しましたが、 csvファイル名が決まってしまうで、他のCSVファイルに展開できません。 できれば、マクロ実行(ファイル選択)ボタンを押すとウィンドウが出てきて、 任意の場所にあるCSVファイルを選択できるようにできないでしょうか? マクロは、書き込むエクセルブックが開いている状態からスタートし、シート名は共通です。 自動記録で完成したマクロは以下の通りです。 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:¥Documents and Settings¥USER¥My Documents¥VBA¥マクロ¥取り込み¥TEST1.csv" _ ’”¥”が誤変換されるので、直接入力しました。      , Destination:=Range("M6")) , Destination:=Range("M6")) _ , Destination:=Range("M6")) .Name = "290TEST1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _ 2) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 '以下、続くので省略しました。 End Sub どなたか、お助けお願いします。

  • 行列入れ替えて貼り付ける方法を教えてください。

    シート1のC3:AF4にあるデータ(右に30個あるデータ)を、シート2のE列の 最終行の1個下から「形式を選択して貼り付け」の「行列を入れ替える」 で、下に30個貼り付けるマクロを書きたいのですが、どうしたらいい でしょうか? 最終行の一個下というところと、行列入れ替えて貼り付けというのが わからなくて…。 また、C3:AF4のE列への貼り付けが終わったらC7:AF8をB列に貼り付け、 C11:AF12をH列に貼り付けたいのです。 画像を添付します。 マクロの自動保存だと失敗してしまったので、これをどう修正したら いいか教えてほしいです。 Sub Macro2() ' ' Macro2 Macro ' ' Range("C7:AF8").Select Selection.Copy Sheets("Sheet2").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("E2").Select Sheets("Sheet1").Select ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 19 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("C3:AF4").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("H2").Select Sheets("Sheet1").Select ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 19 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("C11:AF12").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("B1").Select End Sub よろしくお願いします。

  • Excel 図形へのハイパーリンク

    Excel 図形へのハイパーリンク Excelのシート上で一つのセルに対してハイパーリンクの設定を行いました。 リンク先は同シート上の別の特定セルです。 特定セルにリンクした後、その特定セルが常に左上隅に表示させるように、ThisWorkbookに下記コードを記述しました。 Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) 'リンク先セルを左上隅にして画面表示します ActiveWindow.ScrollRow = Selection.Row ActiveWindow.ScrollColumn = Selection.Column End Sub その後、図形に対して同じようにハイパーリンクの設定を行ったところ、リンクはするのですがリンク先の特定セルが左上隅に表示されなくなってしまいました。 ※図形は、図形の上にテキストボックスを置き、グループ化しています セルに対してと図形に対してでは何か違うのでしょうか。 上記コードは他の方が記述されたものをコピペしただけなので、どの部分を修正すれば良いのか分かりません。 どのようにすれば良いのか教えて頂けませんでしょうか。宜しくお願い致します。

専門家に質問してみよう