エクセル小僧：今月の入力欄に移動する

１月から、１２月までの１２個の入力欄があるエクセルファイル（ワークシート）において、今月の入力欄へ移動するマクロです。

【条件】
・ワークシートは６シートあり、１シートあたり、２か月分の入力欄がある。
・ワークシートの名前は、『1,2月』、『3,4月』、---、『11,12月』
・各月の入力欄の左上のセルの名前：『_1月top』、---、『_12月top』
・マクロ実行前のアクティブシートは、このマクロをコールしているマクロから引数で与えられる。
  Set mySheet = ActiveSheet ' アクティブシートを退避
  Call JpThisMonth1(mySheet)

【コード】
Sub JpThisMonth1(ByVal mySheet1 As Worksheet)
  '【機能】今月のシートへ飛ぶ
  '【引数】
  ' mySheet1 : 実行前のアクティブシート
  '【変数】
  Dim myMonth1(2) As Integer ' 月
  Dim QA1 As Integer ' 質問
  Dim str1(2) As String
  ' 【実行コード】
  myMonth1(0) = Month(Date) ' 今月
  str1(1) = myMonth1(0) & "月のシートに飛びますか？"
  QA1 = MsgBox(str1(1), vbYesNo + vbDefaultButton2, "今月シートへ飛ぶ")
  If QA1 = vbYes Then
   ' 今月のシートをアクティブ化
   ' シート名の例："1,2月"
   Select Case (myMonth1(0) Mod 2)
   Case 1 ' 奇数月
    myMonth1(1) = myMonth1(0) ' 奇数月
    myMonth1(2) = myMonth1(0) + 1 ' 偶数月
   Case 0 ' 偶数月
    myMonth1(1) = myMonth1(0) - 1 ' 奇数月
    myMonth1(2) = myMonth1(0) ' 偶数月
   End Select
   Sheets(myMonth1(1) & "," & myMonth1(2) & "月").Activate
   ' 今月のトップのセルへ移動
   ' セル範囲の名前の例："_1月top"
   Application.Goto Range("_" & myMonth1(0) & "月top"), True
  Else
   mySheet1.Activate ' 実行前のアクティブシートをアクティブ化
  End If
End Sub

【動作確認】
４月は確認しましたが、他の月は確認していません。あしからず

タグ：VBA エクセル 今月 移動

コメント 2

おはようございます。エクセルは奥が深いと思います。^^;
by ソニックマイヅル (2016-04-10 07:52) 

ヤバイぜ!　ありがとうございます[__猫]

ソニックマイヅルさん、
たぶん、エクセルの機能の１％も利用できていないでしょうね（笑）
by cheese999 (2016-04-11 09:02)