SSブログ

エクセル小僧:今日のデータを入力するセルへ(3) [コンピューター]

今日のデータを入力するセルへ(2) 
http://cheese999.blog.so-net.ne.jp/2014-09-26
を、少し変更してみました。

前回の記事では、今日の日付を見つけたら、Application.Goto命令で今日の日付のセルへジャンプし、SmallScroll命令で表示位置を調整するというものでした。

このマクロを実装した表を使ってもらった方から、次の意見をもらいました。
「左から右へ一行目に日付が並んでいる表で、このマクロを動作させたとき、カーソル位置の列番号は今日の日付に合わせて欲しいけど、カーソル位置の行番号は変えないで欲しい。」

例えば、カーソルがD11セル、今日の日付がN1セルある状態でマクロを動作させたら、カーソルがN11セルへジャンプして欲しいということです。

001.jpg

N1セル(今日の日付)を見つけたら、N11セル(新しいカーソル位置)を選択し、N列(今日の列)から、D列(元のカーソル位置の列)の列数の差(=14-4=10)の分、右へスクロールするようにマクロを書き換えました。

01: Sub JumpToday()
02:   ' 機能:今日の日付へ飛ぶ
03:   ' 【変数】
04:   Dim r1 As Range ' 繰り返し用
05:   Dim yy1(2) As Integer ' 年
06:   Dim mm1(2) As Integer ' 月
07:   Dim dd1(2) As Integer ' 日
08:   Dim Flag1 As Integer ' フラグ
09:   Dim Row1 As Long ' 行番号
10:   Dim Column1 As Long ' 列番号
11:   ' 【実行コード】
12:   ' Application.ScreenUpdating = False ' 画面更新停止
13:   yy1(0) = Year(Date) ' 今日の年
14:   mm1(0) = Month(Date) ' 今日の月
15:   dd1(0) = Day(Date) ' 今日の日
16:   Row1 = ActiveCell.Row ' カーソル位置の行番号
17:   Column1 = ActiveCell.Column ' カーソル位置の列番号
18:   ' 今日の日付を探す
19:   Flag1 = 0
20:   Call FindToday1(Range("月日"), r1, Flag1, yy1, mm1, dd1)
21:   ' 今日の日付無し
22:   If (Flag1 = 0) Then
23:     MsgBox "今日(" & Date & ")の日付が見つかりません。"
24:   Else
25:     ' 今日の日付の列、元のカーソル位置の行のセルを選択
26:     Set r1 = Cells(Row1, r1.Column)
27:     r1.Select
28:     ' 今日の日付の列まで右にスクロール
29:     ActiveWindow.SmallScroll ToRight = (r1.Column - Column1)
30:   End If
31:   ' Application.ScreenUpdating = True ' 画面更新再開
32: End Sub

01: Sub FindToday1(ByRef myRange1 As Range, ByRef r1 As Range, _
02: ByRef Flag1 As Integer, ByRef yy1() As Integer, ByRef mm1() As Integer, _
03: ByRef dd1() As Integer)
04:   ' 機能:myRange1の範囲から今日の日付を探し、見つかったら、r1にセル位置を代入
05:   ' 【変数】
06:   ' myRange1 : 今日の日付を探す範囲
07:   ' r1 : 今日の日付のセル範囲
08:   ' Flag1 : 0/1 = 見つからない/見つかった
09:   ' yy1(0) : 今日の年
10:   ' mm1(0) : 今日の月
11:   ' dd1(0) : 今日の日
12:   ' yy1(1) : 探すセル範囲のセルの年
13:   ' mm1(1) : 探すセル範囲のセルの月
14:   ' dd1(1) : 探すセル範囲のセルの日
15:   For Each r1 In myRange1
16:     yy1(1) = Year(r1.Value) ' 年
17:     mm1(1) = Month(r1.Value) ' 月
18:     dd1(1) = Day(r1.Value) ' 日
19:     If (yy1(0) = yy1(1)) And (mm1(0) = mm1(1)) And (dd1(0) = dd1(1)) Then
20:       Flag1 = 1
21:       Exit For
22:     End If
23:   Next r1
24: End Sub

なお、今日の日付を探すセル範囲「月日」は、「$F$1:$AM$1」に設定しています。
1行目、2行目のセルは下記の様になっています。

行番号F列G列-AM列
12014/11/1=DATE(YEAR(F1),MONTH(F1),DAY(F1)+1)-=DATE(YEAR(AL1),MONTH(AL1),DAY(AL1)+1)
2=F1=G1-=AM1


表示形式は1行目が「m/d;@」、2行目が「(aaa)」です。
ヤバイぜ!(7)  コメント(3)  トラックバック(0) 
共通テーマ:パソコン・インターネット

ヤバイぜ! 7

コメント 3

なんだかなぁ〜!! 横 濱男

見てると眠くなります。。(^_^)

by なんだかなぁ〜!! 横 濱男 (2014-11-09 22:51) 

cheese999

なんだかなぁ〜!! 横 濱男さん、
おやすみなさい。。(^_0)ノ
by cheese999 (2014-11-12 01:57) 

cheese999

「ヤバイぜ!」 ありがとうございます。[__猫]
by cheese999 (2014-11-12 01:58) 

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字(英大文字の「オー」、英小文字の「ユー」、アラビア数字の「ハチ」、アラビア数字の「イチ」、アラビア数字の「ニ」)を入力してください。

Facebook コメント

トラックバック 0

トラックバックの受付は締め切りました

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。