VBAで日付を入力したシートでセルがある場合に表示するモジュール

このQ&Aのポイント
  • エクセルのVBAで日付を入力したシートでシートを開くと今日の日付のセルがあった場合、左上に表示させるモジュールの作成方法について質問です。
  • 質問者は、特定のシートで日付を入力し、その日付と一致するセルがある場合に、そのセルを表示するVBAのモジュールを作成しましたが、うまく働いていないとのことです。原因として、セルに入力される日付と一致するセルの範囲が異なることが考えられます。
  • 改善策としては、入力された日付を基準にセル範囲を指定することが必要です。具体的には、入力された日付を参照して、入力日付から一致するセルの範囲を動的に設定するように変更することがポイントです。
回答を見る
  • ベストアンサー

エクセルのVBAで

日付を入力したシートでシートを開くと今日の日付のセルがあった場合左上に表示させるモジュールで、 Sub test() Dim R As Range Set R = Range("A:A").Find(Date) If Not R Is Nothing Then Application.Goto reference:=R, scroll:=True End If End Sub のように作成したのですが、うまく働きません。 原因は、日付を表示したセルが、A1に2006/4/1を入力してA2以降のセルはA1+1、A2+1・・・で対応しています。 よって、アクションが働かないのではと推測しているのですが、このことを改善するにはどのようにしたらいいでしょうか? 日付をダイレクトに入力しないのは、2007年にも先頭セルのみの書き換えで対応しようとしたためです。

  • nkeis
  • お礼率57% (86/150)

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

  • ベストアンサー
  • taocat
  • ベストアンサー率61% (191/310)
回答No.1

こんにちは。 >原因は、日付を表示したセルが、A1に2006/4/1を入力してA2以降のセルはA1+1、A2+1・・・で対応しています >よって、アクションが働かないのではと推測しているのですが おっしゃるとおりです。 ですから、引数LookinのxlValues(値検索)を使えばいいわけです。 Set R = Range("A:A").Find(what:=Date, LookIn:=xlValues) 詳しくはFindメソッドのヘルプを眺めてみませう。 以上です。

nkeis
質問者

お礼

ありがとうございます。無事思い通りに出来るようになりました。またよろしくお願いします。

関連するQ&A

  • 複数のコマンドボタン(VBAで)を一つにまとめたい。

    複数のコマンドボタン(VBAで)を一つにまとめたい。 Private Sub CommandButton1_Click() Application.Goto Reference:=Range("A7"), Scroll:=True End Sub Private Sub CommandButton2_Click() Application.Goto Reference:=Range("A29"), Scroll:=True End Sub Private Sub CommandButton3_Click() Application.Goto Reference:=Range("A51"), Scroll:=True End Sub Private Sub CommandButton4_Click() Application.Goto Reference:=Range("A73"), Scroll:=True End Sub Private Sub CommandButton5_Click() Application.Goto Reference:=Range("A95"), Scroll:=True End Sub Private Sub CommandButton6_Click() Application.Goto Reference:=Range("A117"), Scroll:=True End Sub Private Sub CommandButton7_Click() Application.Goto Reference:=Range("A139"), Scroll:=True End Sub Private Sub CommandButton8_Click() Application.Goto Reference:=Range("A161"), Scroll:=True End Sub Private Sub CommandButton9_Click() Application.Goto Reference:=Range("A183"), Scroll:=True End Sub Private Sub CommandButton10_Click() Application.Goto Reference:=Range("A205"), Scroll:=True End Sub Private Sub CommandButton11_Click() Application.Goto Reference:=Range("A227"), Scroll:=True End Sub 上記のように複数のコマンドボタンを関数化して一つにすることは出来るでしょうか?

  • VBAについて

    いつもお世話になっています マクロ・VBA超初心者です。 質問させてください。 現在シート1の完売のセルの欄に○が入っていれば日付をみてシート2の同じ日付の隣のセルに○を入力しようと思っているのですが、シート2の日付を検索はしているんですが入力がいきません Sheet1  ↓セルA1 ↓セルB1  5月26日   26           B1のセルはDAY(A1)にて出してます         完売  A氏     ○             Sheet2  ↓A列   ↓B列 5月  1日  ・  ・  ・  26日    ○           ←シート1の所に○が付いているとシート1セルB1と同じ  27日                  日付の隣のセルに○を入力  28日 VBA Sub test() Sheets("Sheet2").Select Range("A1").Select Do Until ActiveCell = "" ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = Worksheets("Sheet1").Range("B2") Then ActiveCell.Offset(0, 1).Activate If ActiveCell.Value <> "○" Then ActiveCell.Valu = "○" ActiveCell.Offset(0, -1).Activate Else ActiveCell.Offset(0, -1).Activate End If Else End If Loop Sheets("Sheet2").Select Range("A1").Select End Sub どこが間違っているかわからない状態です。 分かりにくい説明ではあるんですが教えてください お願いします。

  • VBAのGotoについて

    VBA実行後A1セルにカーソルを移動するため Application.Goto Range("A1") End Sub という方法と Application.Goto Reference:=Range("A1") End Sub という方法があると思うのですがどのような違いがあるのですか? 機能的には全く同じだと思うので処理的な違いですか? またその他にも同様の動作をさせるコマンドはありますか? よろしくお願いします。

  • Excel VBA 日付の認識など

    こんにちは。 VBA初心者のものですが質問させていただきます。 ※エクセル2003です 「sheet1のD4:FA4のうち、09年8月以外の日付のセルすべてを選択する」 の構文を下記のように作ってみたのですがうまくいきません・・・ (1)「09年8月」の認識 (2)「~以外のセル全て選択」 の2点がネックで困っています。 ちなみに日付のセルには「2009/8/5」のように入力されており、 表示は「09/8/5」です。 すみませんがご教示お願いいたします。 Sub Macro1() Dim 日付 As Range For Each 日付 In Worksheets("sheet1").Range("D4:FA4") If 日付.Value like"*09/8/*"= false Then 日付.select End If Next End Sub

  • excel vbaについてです

    VBA初心者で、暇な時にいろいろためしています。 以下のマクロを組んだのですが、エラーがでてうまくいきません。 どこがいけないのかご指摘願います。 Sub ather() Dim A As Range Dim B As Range Dim i As Integer With ThisWorkbook.Worksheets("Sheet1") For i = 1 To 30 Set A = Cells(i, 1) Set B = Cells(1, i) If Not .Range(A).Interior.ColorIndex = vbYellow Then GoTo port10 If Not .Range(B).Interior.ColorIndex = vbRed Then GoTo port10 .Range(B).Offset(, 1).Value = "○" port10: Next i End With End Sub イメージとしてはセルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤の時に、 赤色セルの右隣のセルに○を表示させようとしているのですが。。。 こうしたらいいんじゃない?といったアドバイスもお願いします(-人-)

  • エクセルVBAのChangeイベントの書き方について

    またまた質問させてもらいます。 先ほど「エクセルで作業した日の日付を残す」で質問させて 頂いた件での引き続きなのですが、 セルA1~セルL1までのそれぞれのセルに「1」を入力する 作業が有るとします。(1が入力されるか、されないかは任意で また、入力する時刻も異なる) そして、「1」が入力された、その時の時刻をセルA2~セルL2 に表示させるにはどうのようにVBAを書けばいいのでしょうか? セルA1に「1」が入力された場合はA2に表示されるという風に それぞれのセルの下に表示されるという形なのですが。 ちなみに先ほど回答いただいたVBAを少しいじってみて 以下のようなものを作ってみたのでが、これだと常にA1のセルに 「1」が入っているので、毎回時刻が更新されてしまうみたいで、、 この繰り返しを書いてもダメなのですね。 ご回答のほど宜しくおねがいしますーーーー Private Sub Worksheet_Change(ByVal Target As Range) If Range("a1") = "1" Then Range("a1").Value = Now() End If End Sub

  • EXCELVBAについて質問です。

    VBAにて、全てのシートを選択しA1セルをアクティブにするコードを作りたいのですが、計算後、表示位置がばらばらになってしまいます。 Sub シートをすべて選択後A1セルへ移動() Worksheets.Select Application.Goto reference:=Range("a1"), scroll:=True Sheets(1).Select Sheets(1).Range("A1").Activate End Sub 上記のコードなのですが、非アクティブシートは移動せず、セルA1へ移動するのはアクティブシートのSheets(1)のみとなります。 ファイルにあるシート全てをA1に移動後ウィンドウもA1に移動するような命令文はあるのでしょうか?

  • Excel VBA 範囲の条件付け

    現在下記のコードを組んでいます。 やりたい事は、sheet1~3で背景色の赤いセルと、 そのセルの上方の最初の空白セルの下3行をsheet4にコピペする。 【下記コードで実現出来ていないこと】 1.背景色が赤いセルとそのスグ上の3行をコピペしてしまう。 2.同じシートに背景色が赤いセルが複数あっても、1つしかコピペしない。 3.sheet4のコピペ先をA3、A13、A23と仮に指定しているが、  sheet1のコピペ内容に1行空けて、sheet2のコピペ内容、  また1行空けて、sheet3のコピペ内容というセル指定にしたい。 以上、よろしくお願い致します。 Sub Test() Dim i As Long, r As Range With Worksheets("sheet1") For i = 1 To .Range("A65536").End(xlUp).Row If .Range("A" & i).Interior.ColorIndex = 3 Then Set r = .Range("A" & i).EntireRow Set r = Union(r, r.End(xlUp).Resize(3).EntireRow) End If Next i End With If Not r Is Nothing Then r.Copy Sheets("Sheet4").Select Range("A3").Select ActiveSheet.Paste With Worksheets("sheet2") For i = 1 To .Range("A65536").End(xlUp).Row If .Range("A" & i).Interior.ColorIndex = 3 Then Set r = .Range("A" & i).EntireRow Set r = Union(r, r.End(xlUp).Resize(3).EntireRow) End If Next i End With If Not r Is Nothing Then r.Copy Sheets("Sheet4").Select Range("A13").Select ActiveSheet.Paste With Worksheets("Sheet3") For i = 1 To .Range("A65536").End(xlUp).Row If .Range("A" & i).Interior.ColorIndex = 3 Then Set r = .Range("A" & i).EntireRow Set r = Union(r, r.End(xlUp).Resize(3).EntireRow) End If Next i End With If Not r Is Nothing Then r.Copy Sheets("sheet4").Select Range("A23").Select ActiveSheet.Paste End Sub

  • 印刷後のVBAの実行 (3)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24~33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか? ご回答お願いします

  • Excel VBAについて

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub Application.Goto Worksheets("人件費").Range("A1") Worksheets("人件費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub Application.Goto Worksheets("外注費").Range("A1") Worksheets("外注費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub 上の指令はFの列をダブルクリックすると人件費のシートが開いてAある値を人件費の新しいセルのAに代入する指令ですが それをG列ダブルクリックで外注費シートに同じようにやろうと思いましたが出来ません。 たぶん根本的に書き方が間違っているのかと思われますが、ご指導のほどお願いします。

専門家に質問してみよう