VBAでセルに入力した値に応じて別のセルに自動的に日付を入力する方法とは？

前へ 次へ
このQ&Aのポイント
  • 希望通りの回答があったのですが、カスタマイズできません。同じ質問ということになるかもしれないのですが、この質問の回答の中の、VBA文で、A列に入力すると、B列に入力した時点の日付が自動的に入力されるという方法について教えてください。
  • VBAのヘルプや書籍で調べましたが、自分のシート用にカスタマイズする方法が見つかりませんでした。また、この方法がどのように動作するのか、どのような作業がされて自動的に日付が入力されるのかも教えていただきたいです。
  • また、A列以外の列でも同様の方法を使いたい場合、どの部分を変更すればよいのかも教えていただけると幸いです。
回答を見る
  • ベストアンサー

希望通りの回答があったのですが、カスタマイズできません。

同じ質問・・・ということになるかもしれないのですが、この質問 http://oshiete1.goo.ne.jp/kotaeru.php3?q=116276 の回答の中の、ＶＢＡ文で、Ａ列に入力すると、Ｂ列に入力した時点の日付が自動的に入力されるというものなのですが、 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "Sheet1" Then 'Sheet1を変更 If Target.Count = 1 Then 'A列を変更 If Target.Column = 1 Then '1つのセルを変更 Application.EnableEvents = False 'イベントの発生を止める If Target <> "" Then 'A列で入力した場合 Target.Offset(0, 1) = Format(Now(), "yyyy/mm/dd h:mm") Else 'A列で消去した場合 Target.Offset(0, 1) = "" End If Application.EnableEvents = True End If End If End If End Sub すごく使いたいのですが、自分のシート用にカスタマイズすることができません。 ＶＢＥのヘルプや、書籍で調べたのですが、どうしてもうまくいかないので、 質問させてください。 この場合、Ａ列に入力するとＢ列に出るようになっているのですが、他の列で使いたい場合、どこをどう変えれば良いのでしょうか？ また、考え方（仕組み）として、どういう作業がされて自動的に出てくるようになっているのでしょうか？（これは勉強のために聞きたいのですが） コメントがところどころに書いてもらっているのですが、勉強不足で申し訳ありませんが、すぐ使いたいＶＢＡなので、どうか教えてください。

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

  • ベストアンサー
  • ahsblue
  • ベストアンサー率58% (23/39)
回答No.2

追加の質問にお答えします。 複数の条件のいずれかを満たす場合は「OR」で連結が可能です。 例の場合ですと、Ａ列、Ｃ列に値が入った時間を右隣のセルに入れるということを行う訳ですから、プログラムにすると、４行目が以下のように変わります。 If Target.Column = 1 or Target.Column = 3 Then でよろしいかと思います。

fruit-gogo
質問者

お礼

遅くなって申し訳ありません。 本当にありがとうございます！！！ できました！うれしいです。 そうか、Ａ列に入ったとき、または、Ｃ列に入ったとき・・・という風に考えるのですね～。教えていただくと単純ですが、自分で指示を考えるとなるとそういう風に思い浮かびません。何だか難しく考えてしまって・・・。 こんなこと、手入力すればいいことではないか！と思われるでしょうが、 いくつもの作業を同時に進めていますので、これで、現時点での数をメモを取るように入力するだけで、誰でも使える表ができました。 早速使えます。 本当にありがとうございました<(_ _)>

その他の回答 (1)

  • ahsblue
  • ベストアンサー率58% (23/39)
回答No.1

まずは、解説からです。 １行目：関数宣言部分で引数はシートオブジェクト、レンジオブジェクトです。 ２行目：シート名が「Sheet1」である場合、次の処理を行う ３行目：現在選択している範囲が１列である場合、次の処理を行う。 ※※※→質問のコメントは適切でないと思います。 ４行目：選択している列がＡ列である場合、次の処理を行う ５行目：イベントの多発防止のおまじない。 ６～７行目：選択セルに値が入っている場合、Ｂ列に日時設定 ８～９行目：選択セルが空欄の場合、Ｂ列の日時を削除 １１行目：イベント多発防止のおまじない解除 という感じですね！ Ａ列の変更は、４行目を変更します。 Ａ＝１、Ｂ＝２、・・・Ｚ＝２６、ＡＡ＝２７という感じです。 Ｂ列は、Ａ列を起点にした場所を指定しています。 ９行目がそれにあたりまして、offset（０，１）の部分です。 左に書いてる０の意味：行（縦方向）を表していまして、 １つ上の行＝－１ 同じ行＝０ １つ下の行＝１ 右に書いてる１の意味：列（横方向）を表していまして、 １つ左の列＝－１ 同じ列＝０ １つ右の列＝１ という意味です。いかがでしょうか？

fruit-gogo
質問者

補足

早速の回答、ありがとうございます！！ 解説どおり、他の列で試してみたところ、うまくいきました！ 私はどうも、見当違いの場所を変更していました。 このように解説していただくと、難解な作業をしているわけでもなく、こんなに便利になるんですねー。 ＶＢＡ、がんばって勉強しようという気持ちがさらに強まりました。 丁寧な解説をいただいたのにさらに・・・というのは言いづらいのですが、もしよろしければ、これを同じシートで２つの部分で使うには、どこを変えればよいのか教えていただけないでしょうか？というのは、 私が作っているシートでは、開始時刻と、終了時刻という項目があり、その両方でできれば使いたいのです。（これはＡから始まるとしますが） 　開始時刻　　　　終了時刻 Ａ列　　Ｂ列　　Ｃ列　　Ｄ列 数　　　時刻　　　数　　時刻　　←項目名 50　　11：00　　100　　12；00 このように、Ａ列に計測開始時刻の時点での数量を入れると、Ｂ列にその時刻が自動的に入り、計測終了時刻の時点での数をＣ列に入れると、その時刻が自動的にＤ列に入るというものを作りたいのです。 これは無理でしょうか？こうしたい場合、まったく別のマクロになってしまうのでしょうか？ すみません！！どうかお願いいたします。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • このEXCELVBAを複数のセルにも別々に同じ処理をしたい

    はじめまして。 過去ログに私のやりたいような内容を探していたらこのような下記のエクセルVBAがあったので、 教えて頂きたいです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With With Cells(ActiveSheet.Rows.Count, "C").End(xlUp) .Offset(1, 0).Value = x .Offset(1, 1).Value = Time() End With End Sub A1に入力するたびに同一セルに加算。 A1をクリアできる。 C列に入力履歴、D列に入力時間を記録。 If Target.Address <> "$A$1" Then Exit Sub　の$A$1を変えることによって他のセルにも設定できる。 と、いう内容なのですが、これを同一シートの複数のセルにも同じよう別々に処理できるように設定したいのですが、 どのようにすればいいのでしょうか？ VBAは最近始めたばかりなのでわからない事だらけです。 Excelのバージョンは2003です。 よろしくお願い致します。

  • 郵便番号から住所を自動表示

    お世話になります。 Excel 2016を使用して、A列のセルに郵便番号を入力すると、B列のセルにその住所を表示するようにしたいと思います。Webから検索した次のようなVBAをSheet1のシートモジュールとして貼り付けました。 Private Sub Worksheet_Change(ByVal Target As Range) '範囲は、A2～A100 に郵便番号を入力する場合 If Intersect(Target, Range("A2:A100")) Is Nothing Then Exit Sub If Target.Count > 1 Then Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False With Target.Offset(0, 1).Validation .Delete .Add Type:=xlValidateInputOnly .IMEMode = xlIMEModeHiragana End With If Target Like "###-####" Then Target.Offset(0, 1).Select SendKeys Target.Value SendKeys "{ }" SendKeys "{ENTER}{ENTER}" SendKeys "{Left}" End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub この結果自分の住所の郵便番号の場合はうまく表示されました。そのほかの番号の場合は、 瞬間的に何か表示されたような気はしますが、結果的には列に入力した番号が表示されます。 またうまく表示されないB列の郵便番号を変換キーで住所に変換する作業を3～4回繰り返した後にこの番号をA列に入力するとB列にこの住所が表示されます。「学習した番号については、うまくいく」ような感じです。 何か解決する方法はないでしょうか。 よろしく願いします。

  • ドラッグした際のエラー回避

    以下のようなVBAを組んだのですが、オートフィルタでV列をリストのいずれかを選択中にドラッグすると「型が一致しません」というエラーを起こします。 最悪、オートフィルタ中はドラッグ不可でもかまいません。 ご教授ください。 （WiｎXp/Access2003) Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) '列の色変更 Dim myColor As Variant Dim myFontColor As Variant If Target.Column = 1 Then GoTo S If Target.Column = 9 Then GoTo K If Target.Column = 25 Then GoTo Y If Target.Column = 22 Then GoTo A If Selection.Cells.Count > 1 Then Exit Sub Exit Sub S: 'A列入力時 If Not Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value <> "" And Target.Offset(0, 4) = "" And Target.Offset(0, 2) = "" Then Target.Offset(0, 2) = "TypeA" Target.Offset(0, 5) = "未" Target.Offset(0, 6) = Date Target.Offset(0, 1).Select End If Application.EnableEvents = True Exit Sub K: '故障入力時 If Not Intersect(Target, Range("K1:K10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value = "Y" Then Target.Offset(0, 13) = "故障" Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 7 Target.Offset(0, 1).Select Else End If Application.EnableEvents = True Exit Sub Y: 'Y列入力時 If Not Intersect(Target, Range("Y1:Y10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value <> "" And Target.Offset(0, 1) = "" And Target.Offset(0, 2) = "" Then Target.Offset(0, -3) = "売却済" Target.Offset(0, 1) = Date Target.Offset(0, 2) = "未" Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 16 Else End If Application.EnableEvents = True Exit Sub A: If Not Intersect(Target, Range("A1:AB10")) Is Nothing Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case "故障" myColor = 7 'ピンク myFontColor = 1 Case "修理中" myColor = 37 '薄い水色 myFontColor = 1 Case "担当出(1)" myColor = 3 '赤 myFontColor = 1 Case "担当出(2)" myColor = 8 '水色 myFontColor = 1 Case "担当出(3)" myColor = 4 '蛍光緑 myFontColor = 1 Case "担当出(4)" myColor = 6 '黄色 myFontColor = 1 Case "担当出(5)" myColor = 5 '青 myFontColor = 1 Case "担当出(6)" myColor = 10 '深緑色 myFontColor = 1 Case "売却済" myColor = 16 '濃灰色 myFontColor = 1 Case "廃棄", "修理不可能" myColor = 47 '群青 myFontColor = 2 '白 Case "保守用" myColor = 49 '群青 myFontColor = 2 '白 Case Else myColor = xlNone End Select Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = myColor Cells(Target.Row, 1).Resize(1, 28).Font.ColorIndex = myFontColor Application.EnableEvents = True End Sub Private Sub AFall() If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If End Sub

  • EXCEL　VBAについて教えてください

    はじめまして。 過去ログに私のやりたいような内容を探していたらこのような下記のエクセルVBAがあったので、教えて頂きたいです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With With Cells(ActiveSheet.Rows.Count, "C").End(xlUp) .Offset(1, 0).Value = x .Offset(1, 1).Value = Time() End With End Sub A1に入力するたびに同一セルに加算。 A1をクリアできる。 C列に入力履歴、D列に入力時間を記録。 If Target.Address <> "$A$1" Then Exit Sub　の$A$1を変えることによって他のセルにも設定できる。 と、いう内容なのですが、これをたとえば同一シートのA1～E10のセルとA12～Ｅ22にも同じよう別々に処理できるように設定したいのですが、どのようにすればいいのでしょうか？ちなみにA11～Ｅ11とA23～Ｅ23は合計を表示するセルにしたいです。 Excelのバージョンは2003です。 よろしくお願い致します

  • エクセルのマクロで上のセルの数式を相対参照でコピーしたい（フィルみたいに）

    エクセル2002で以下のようなシートがあります。 　|　A　|　B　|　C　|　D --------------------------- 1　|　　1|　10|　100|　=C1-1 --------------------------- 2　|　　 　|　 　　|　 　　|　 ここで、B2に文字が入力されると、A1とC1とD1をコピー、B2が消されるとA2とC2とD2を消去するマクロを書きました。 現在以下のように書いていますが、これでは入力位置がB2だろうがB3だろうかB20だろうが、D2と同じ数式になってしまいます。B5に入力されたならD5の数式はC5-1にしたいのですが、このような入力をするにはどうすればよいでしょうか。 ちなみにD列の数式は本当はもっと複雑です（この数式ならTarget.Offset(0, -4).Value = Int(Target.Offset(-1, -4).Value + 1でもたぶんいい・・・はず・・・） オートフィルを使えば！と思いましたが、Target・・・では使い方がわかりません。 Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Column <> 2 Then Exit Sub 　　//B列以外への文字入力はマクロ停止（のつもり） If Target.Value <> "" Then Target.Offset(0, -1).Value = Int(Target.Offset(-1, -1).Value + 1) 　　//A1に+1したものをコピー Target.Offset(0, 1).Value = Target.Offset(-1, 1).Value 　　//C2にC1をコピー Target.Offset(0, 2).Formula = Target.Offset(-1, 2).Formula　　//D2にD1の数式をコピー◆ここが問題！ Else Range(Target.Offset(0, -1), Target.Offset(0, 4)).ClearContents End If Application.EnableEvents = True End Sub

  • Excel 2000です。VBAを改造していただきたいのですが

    入荷品のチェックシートです。B列に受領数を入力するとA列に年月日が記録されるVBAを作っていただき必要なブックのシートごとにコピーして使っていました。全品入荷完了後 別のロットにシートタブの名目を書き換えて再利用します。 　（'複数セルが選択された場合、動作をキャンセル　 がなぜ必要かも理解できないVBAの勉強を挫折の高齢者です） B列のセル一個づつ選択削除でないとB列が空白になるだけでA列には日付が残ります。複数のセル選択で一気に日付を削除したいのです。 お助けください。 Private Sub Worksheet_Change(ByVal Target As Range) '複数セルが選択された場合、動作をキャンセル If Target.Count <> 1 Then Exit Sub If Intersect(Target, Range("B5:B1000")) Is Nothing Then Exit Sub 'B5:B1000"の範囲外は除外 Application.EnableEvents = False If Target.Value <> "" Then If IsDate(Target.Offset(, -1).Value) Then GoTo EXIT_LABEL '日付が記入済の場合は実行しない Target.Offset(, -1).Value = Format$(Now, "mm/dd hh:mm") Else 'セルを空白にした場合、日付を削除 Target.Offset(, -1).Value = "" End If EXIT_LABEL: Application.EnableEvents = True End Sub

  • ThisWorkBookモジュールとSheetモジュールの両立

    エクセル２００３でマクロを組んでいます。 Sheet1,Sheet2の２つのシートがあり、 片方のシートの"A4:G10"の範囲に値を書き込むと、もう片方の同じ位置に同じ値が書き込まれるようなマクロを組みたいです。 以前ここで教えていただいたものを改変して以下を作りました（ThisWorkBookモジュールです）。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim r As Range Dim Num As Integer Dim S As String, Sh_name As String Sh_name = ActiveSheet.Name Set r = Intersect(Target, Range("A4:G10")) If Not (r Is Nothing) Then Application.EnableEvents = False For Num = 1 To 2 S = "Sheet" & Num If S <> Sh_name Then Worksheets(S).Range(r.Address).Value = r.Value End If Next Application.EnableEvents = True End If End Sub ここまでは正常に動作します。 また、 Sheet1とSheet2のモジュールに、 A列のセルに値が入力された場合、同じ行のC列のセルの色を塗るという記述をしています。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then Cells(Target.Row, 3).Interior.ColorIndex = 5 End If End Sub これらを同時に生かしたいのですが、 どのように書けばいいでしょうか。 EnableEvents = False／Trueを消してしまうと、 Worksheets(S).Range(r.Address).Value = r.Valueが実行されるたびにThisWorkBookモジュールが動いているようです。 そして2回目のSet r = Intersect(Target, Range("A4:G10"))でエラーが出ます。 （エラーは出ずとも延々と(無限ではない回数)ThisWorkBookモジュールを繰り返したコードもありました。） よろしくお願いします。

  • ２つのマクロの組合せがうまくいきません

    Excel2002を使用しています。 ・シートに変更があった場合、可否を問うメッセージを出す。 ・但し、「A1」及び「D、E列」の変更は除外する。 ・「D、E列」をダブルクリックしたら、アクティブセルに「済」の文字が入る。 という事をしたくて、Sheet1に以下のようなコードを書きましたが、うまくいきません。 「A1」の変更は除外されるのですが、DE列への変更はメッセージが出てしまいます。 又、そのメッセージが出た際「いいえ」を選択するとエラーになります（Application.Undo）。 Private Sub Worksheet_Change(ByVal Target As Range) Dim 変更回答 As Integer If Target.Address = "$A$1" Then Exit Sub If Target.Columns = ("4:5") Then Exit Sub 変更回答 = MsgBox("セル：" & Target.Address(False, False) & "が変更されました。" & vbCrLf & _ "　　　「はい」　… 変更許可" & vbCrLf & "　　　「いいえ」… 内容破棄", vbYesNo) Application.EnableEvents = False If 変更回答 = vbYes Then Application.EnableEvents = True Exit Sub Else Application.Undo End If Application.EnableEvents = True End Sub 　　　＊＊＊＊＊＊ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 4 Then ActiveCell = "済" Cancel = True End If If Target.Column = 5 Then ActiveCell = "済" Cancel = True End If End Sub 以上、ご教授、宜しくお願い致します。

  • VBAの記録を追加したい

    エクセル2002使用です。 VBAで次のコードを使っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Set Target = Intersect(Range("C:C"), Target) If Target Is Nothing Then Exit Sub For Each Rng In Target If Rng.Value <> "" Then Rng.Offset(, -2).Value = Now Else ' (*) Rng.Offset(, -2).Value = "" ' (*) End If Next Rng End Sub （C列のセルに何か入力されると、A列の同じ行にその時刻が入る。） 同じシートで、F列に何か入力されるとE列の同じ行にその時刻が入るように書き直したいのですが、どうすればいいのでしょうか？ すいませんが、よろしくお願いします。

  • エクセルVBAの書き方で教えてください。

    エクセルで、 「A列にデータを入力した日付をB列に自動で入れる」 （A列のデータを消したときは、B列のデータも消える）ということをするのに、 他の質問を参考にして、 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then 　 '対象の列が1列目(A列)なら If Target.Value <> "" Then 　 '入力された値がブランクでなければ Target.Offset(0, 1).Value = Date 　 '0行ずれた(同じ行）の1列右隣に日付を入れる Else 　　　　　 'そうでなければ(Deleteキーで消されたら） Target.Offset(0, 1).Value = "" 　 '同行右隣をブランクすなわち""として消す End If 　　　　 '入力された値の処理終り End If 　　　　 '1列目(A列）の処理終り、従ってB列以降はチェックしない End Sub と、入力して、うまく動きました。 ところが、「A列に入力」→「B列に自動で日付」だけでなく、 「D列に入力」→「E列に自動で日付」 「H列に入力」→「I列に自動で日付」と、1つのエクセルシートの中で いくつかの同じ条件のことを繰り返そうと思うとうまくいきません。 この場合、どのようにVBAを記入したら良いのか、教えてください。 よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する