日付を自動入力する方法
- 入力フォームと言うシートの日付列A8からA22まで日付を入れるようにしています。
- VBAを使用して日付のセルを選択し、日付が自動で入るボタンを押して本日の日付を入力しています。
- 日付のマクロボタンを押す毎に、A8からA22まで順番に入力できるようにする方法を教えてください。
- ベストアンサー
日付を自動入力する方法
入力フォームと言うシートの日付列A8からA22(A8からD8まで結合して、このパターンでA22まであります）まで日付を入れるようにしています。右隣の列E8からE22は商品名が入る列です。 今は、下記のVBAで日付のセルを選択して、日付が自動で入るボタンを押して、本日の日付を入力しています。K28には=today()の関数が入っています。 Sub 日付入力() ActiveSheet.Unprotect Range("K28").Copy ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Protect End Sub これを日付のマクロボタンを押す毎に、A8からA22まで順番に入力できるようにするにはどうすればよいでしょうか？ 尚、入力フォームの作成・保存が終わるとA８からA22まですべて、セルの値を消去するマクロボタンを作っています。
- shibushijuko
- お礼率91% (258/283)
- Visual Basic
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
>日付のマクロボタンを押す毎に ということなら、 Sub 日付入力() Const SLineNum = 8 Const ELineNum = 22 Dim wkCount As Integer wkCount = SLineNum With ThisWorkbook.Sheets(1) Do If wkCount > ELineNum Then Exit Do End If If .Cells(wkCount, 1).Value = "" Then '.Cells(wkCount, 1).Value = Now ’注１ .Cells(wkCount, 1).Value = .Cells(28, 11).Value Exit Do End If wkCount = wkCount + 1 Loop End With End Sub でいかがでしょうか？ 注１は、K28を使わない場合です。
関連するQ&A
- エクセルでの自動日付入力
エクセルでこんなことできますか？ Ｂ列以降のどれかのセルに変更を加えて（セル内に文字入力、セル内の文字削除）、保存した後閉じます。 次回そのファイルを開いたとき変更したセルのある行の Ａ列に保存した日付を表示させたいです。 「この行がいつ変更されたか」を知りたいのです。 わかりにくくてすみません。 マクロは初心者です。（たぶんマクロでないと無理？） よろしくお願いします。
- 締切済み
- オフィス系ソフト
- EXCELのシート名自動入力
EXCELでシート名にセルA1の値を自動入力したいので、 下記のマクロを使いましたが、いちいちマクロを実行しないと自動入力できません。 Public Sub SheetName() ActiveSheet.Name = Range("A1").Value End Sub これを、マクロを実行しなくても、セルA1の値が変わった時点で 自動的にシート名も変わるようにできないでしょうか？
- 締切済み
- Excel（エクセル）
- マクロに詳しい方！エクセルの日付入力について
エクセルの日付入力について、例えばＢ列に何か入力したら自動的にＡ列に入力した日がＢ列に表示されるようにする方法（TODAY関数のように常に現在の日付ではなく、入力した日のまま固定にする方法）について検索したところ、下記の通り、マクロをつかった回答がありました。 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1413916824 Ｂ列に入力し、Ａ列に日付を書き込む場合 B1→A1 B2→A2 B3→A3 … -------------------- Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 2 Then Exit Sub Application.EnableEvents = False Target.Offset(, -1).Value = Now Application.EnableEvents = True End Sub -------------------- 小生はマクロが分かりませんが、上記のコードをコピペ入力すると、その通りになりました。 そこで、みなさんにご相談ですが、これをＡ列に入力→Ｂ列に日付、Ｃ列に入力→Ｄ列に日付、Ｅ列に入力→Ｆ列に日付・・・・・というようにしたいのですが、そのコードを教えて頂けないでしょうか。 何卒お知恵をお借りしたくお願い致します。
- ベストアンサー
- その他MS Office製品
- 自動で採番と日付を入力するマクロ
Sheet１のC列に何かを入力すると、A列に１から番号が振られていき、B列には入力した日付が 入っていくマクロを作りたいです。ご教授教えていただければ幸いです；
- ベストアンサー
- オフィス系ソフト
- Excelで日付と時間の自動入力
教えてください。 エクセルで表を作っているのですが、 Ｄ列に文字を入力すると、 Ａ列に入力した日付 Ｂ列に入力した時間 を「自動で」表示させたいのですが…マクロやＶＢＡなどでできますでしょうか？ できれば、Ｄ列の文字を消すと日付と時間も消えるようにしたいです。 初心者で申し訳ないのですが、よろしくお願いします。
- ベストアンサー
- Windows XP
- 日付入力マクロ
On Error Resume Next Dim r As Range Dim flg As Long flg = 0 If Intersect(Target, Range("A4:A600,E4:E600,J4:J600")) Is Nothing Then Exit Sub 'A列のみを対象 最初につなげるところ ActiveSheet.Unprotect flg = 1 For Each r In Target Dim a As Long Dim b As String With r If Not .NumberFormatLocal = "ge.m.d" Or .Value = "" Then .NumberFormatLocal = "G/標準" 'セルの書式設定がH00.m.d形式だったら標準に戻す 'セルが 数字 且 整数 且 101以上 且 991231以下 の場合 If IsNumeric(.Value) And Int(.Value) = .Value And .Value >= 19010101 And .Value <= 20991231 Then b = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2) If IsDate(b) Then 'もしbがDateの形なら .Value = CDate(b) 'データ型を日付にする 'ここにつなげる。 変数はtmpからbに直す .NumberFormatLocal = "ggg" & _ IIf(Format(b, "e") > 9, "e年", "_0e年") & _ IIf(Month(b) > 9, "m月", "_1m月") & _ IIf(Day(b) > 9, "d日", "_1d日") ActiveSheet.Protect End If End If End With Next End Sub 上記のマクロで20090731と入力すると平成21年7月31日と表示されます。 210731を入力して平成21年7月31日と表示されるようにすることは可能ですか？
- ベストアンサー
- オフィス系ソフト
- Excelマクロ 曜日自動入力方法
マクロ初心者です。 こちらのサイトから日付の自動入力の方法がわかりました。 Sub Macro1() Dim f As String f = ActiveCell.NumberFormat ActiveCell = Now End Sub ↑の右セルに曜日を自動入力したいのですが・・・ 追加するコード？を教えてほしいです。 （選択したセルA1には"7/24"をセルB1"土" のマクロ）
- ベストアンサー
- その他MS Office製品
- エクセルマクロ 日付を検索し入力
エクセル2003マクロを使用して以下の事を行いたいと思っていますが、どのようなマクロを組んだらよいか分かりません。よろしくお願いします。 シート上部にある以下のデータを A B C D E 1 日付 商品A 商品B 商品C 商品D 2 5/26 5 6 1 3 ←その日のデータ（毎日変わる） 入力ボタンを作成し、それを押すことにより ↓ 6 5/1 7 ・ 8 ・ 9 5/26 5 6 1 3 10 ・ ↑日付が予め入力された表 上記のような、同一シート上の日付欄に入力される表を作りたいのですが、方法が分かりません。 その日のデータは、別シートに入力用フォームを作成し、飛ばしています。何人かの人間が入力するので、マクロで簡単に、行えるようにしたいと思います。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excelで入力日の自動入力日を格納するには
入力日を自動入力して、その日付を格納します。 さらに、隣のセルにコピーして入力日で並べ替えをしたいのですが 並べ替えが出来ません。 (1)A2～A10に何か入力したら、B列に入力日を返します。 Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Integer, c As Integer 'r 行番号 'C 列番号 r = Target.Row c = Target.Column If c <> 1 Or r < 2 Or r > 10 Then End If Cells(r, c) <> "" Then Cells(r, c + 1) = Format(Now, "yyyy/m/d") Else Cells(r, c + 1) = "" End If End Sub 上記で、入力日を格納するところまでは出来ました。 (2)続いてマクロ【並べ替え】で、A2－B10をコピーし、E2へ貼り付け、 日付降順で並べ替えをします。 Sub 並べ替え() Range("A2:B10").Select Selection.Copy Range("E2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("E:F").Select Selection.Sort Key1:=Range("F2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Range("F2").Select End Sub (3)上記マクロをコマンドボタンに貼り付けましたが、 貼り付けまではいきましたが、並べ替えができませんでした。 コードで並べ替え制限などかかってるのでしょうか？？ よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで教えて下さい。
A1のセルに [ 1- 5] 4.05398e-01 3.63385e-01 -2.22992e-01 9.89158e-03 -6.43695e-02 A2のセルに [ 6-10] -5.12224e-04 4.07480e-04 -2.73746e-04 -1.77853e-02 -2.13805e-03 A3のセルに [11-15] -6.88489e-03 -2.06765e-02 -9.44633e-03 6.97059e-03 -1.28400e-02 と、このような感じでA7セルまで同じ感じでスペースで空いた数値が入力されています。 A8のセルのみ [36-37] -6.39210e-03 -1.55806e-03 と入力されております。 まず行いたいのはスペースが空いてる部分で、それぞれの数値を各セルに分けたいです。 A1のセルに入力されている [ 1- 5] 4.05398e-01 3.63385e-01 -2.22992e-01 9.89158e-03 -6.43695e-02 ならば A1に[1-5] B1セルに4.05398e-01 C1セルに3.63385e-01 のように これをA1からA8のセルで行ったあと指定のセルを30行目に貼り付けます。 E1→A29 C2→B29 D2→C29 E2→D29 E3→E29 F3→F29 B4→G29 D5→H29 E5→I29 F5→J29 貼り付けのデータは増えていきます。つまり、30行目にデータが入ってる場合は そのデータが1行下の行に下がり、新たなデータが30行目に追加されます。 このようにして、データが最大で５８行目まで追加される可能性があります。 最小であれば30行目、31行目の２つしかない場合あります。 この時、０の近似値を各列のセルから探し、当てはまるセルを赤く塗り潰すというのが 今回行いたいことです。 A列ならA30～A58までの中で０の近似値を探し、当てはまるセルを赤く塗り潰す。 ただ空白の場合は無視してもらいたいです。０の近似値だと空白が選択されてしまうので。 近似値探しの前までならマクロがありますのでご参照下さい。 Sub Macro4() ' ' Macro4 Macro ' ' Range("A1:A8").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(21, 1), Array(34, 1), Array(47, 1), _ Array(60, 1)), TrailingMinusNumbers:=True Range("A1").Select Range("E1").Select Selection.Copy Range("A29").Select ActiveSheet.Paste Range("C2:E2").Select Application.CutCopyMode = False Selection.Copy Range("B29").Select ActiveSheet.Paste Range("E3:F3").Select Application.CutCopyMode = False Selection.Copy Range("E29").Select ActiveSheet.Paste Range("B4").Select Application.CutCopyMode = False Selection.Copy Range("G29").Select ActiveSheet.Paste Range("D5:F5").Select Application.CutCopyMode = False Selection.Copy Range("H29").Select ActiveSheet.Paste Range("J7").Select Application.CutCopyMode = False Range("A29:K29").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A29:K29").Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("A29").Select Range("A1:F8").Select Selection.ClearContents Range("A1").Select Range("K29").Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormatLocal = "G/標準" End Sub わかりずらい質問ですみませんが、ご指導の程 お願い致します。
- ベストアンサー
- Excel（エクセル）
お礼
ご回答ありがとうございます。まさに希望と通りに動作しました。 本当に助かります。m(_ _)m