エクセルでデータ入力された日付と時間を自動入力する
A1をA2に、B1をB2に、C1をC2に･･･ A1に入力したらA2に更新日付が入るという様に行いたいのですが、 ---------------- Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim r As Range For Each r In Target If r.Column = 1 Then r.Offset(0, 1).Value = Format(Now, “yyyy/mm/dd”“ ”“hh:mm:ss”) End If Next r End Sub ---------------- これをどのように改編したらいいのでしょうか？
- ベストアンサー
- Excel（エクセル）
毎月とか隔週に連動して日付を変えたい
OKWAVEで質問してある程度出来が上がってきましたが、まだ解決できないところがあり、ご指導下さい、 M列に０以上の数字が入力されたらA列の日付を変えたい B列の　毎日は　＋１日後 B列の　毎週は　＋７日後つまり M1に０以上なら　5／5が表示できるようにしたい(＋１日後) M6に０以上なら　5／13が表示できるようにしたい(＋７日後) それが下記の計算式です。 ------------------------------------- エクセルのシート名タブを右クリックしてコードの表示－現れたシートに下記をコピー貼り付けています Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim h As Range Dim c As Long On Error Resume Next For Each h In Application.Intersect(Target, Range("M:M")) If h > 0 Then If Cells(h.Row, "B") = "毎日" Then c = 1 ElseIf Cells(h.Row, "B") = "毎週" Then c = 7 Else c = 0 End If Cells(h.Row, "A") = Cells(h.Row, "A") + c End If Next End Sub －－－－－－－－－－－－－－－－＜質問１＞毎月、隔月、隔週　　は下記であってますか？どこに入れたら動作するのでしょうか？ ElseIf Cells(h.Row, "B") = "毎月" Then c = 30 Else c = 0 End If ElseIf Cells(h.Row, "B") = "隔月" Then c = 60 Else c = 0 End If ElseIf Cells(h.Row, "B") = "隔週" Then c = 14 Else c = 0 End If 投稿日時 - 2012-05-04 10:29:04
- ベストアンサー
- その他MS Office製品
どこを修正すれば　日付が変わるのか？
先ほど、 http://okwave.jp/qa/q7454676.html の質問して　サンプルにはきちんと作動することを確認しました。そこで、サンプル版ではないものに手を加えても動作がうまくいきません private sub Worksheet_Change(byval Target as excel.range) 　dim h as range 　on error resume next 　for each h in application.intersect(target, range("C:C")) 　　if h = "完了" then 　　if h.offset(0, -1) = "毎日" then 　　　h.offset(0, -2) = h.offset(0, -2) + 1 　　elseif h.offset(0, -1) = "毎週" then 　　　h.offset(0, -2) = h.offset(0, -2) + 7 　　end if 　　end if 　next end sub －－－－－－－－－－－－－　for each h in application.intersect(target, range("N:N")) と変更したのですが、動作しません。どこを修正すれば、動作するでしょうか？
- ベストアンサー
- Visual Basic
日付を入れるとセルがおかしくなります。
http://okwave.jp/qa/q7495702.html　以前の質問で、空白になった行を詰めていくようなマクロをおしえていただき、mt2008さんのコードを利用しているのですが、新たにB列に、C列に何かが入力されたら日付を挿入する以下のマクロをいれました。 Private Sub worksheet_change(ByVal Target As Excel.Range) Dim h As Range On Error Resume Next For Each h In Application.Intersect(Target, Range("C:C")) If h <> "" Then Cells(h.Row, "B") = Date End If Next End Sub このマクロはちゃんと動いたのですが、実はここで困ったことが発生しました。空白行を詰めた時、日付が詰めた日付に更新されてしまうのです。これは、B列の文字列が変わるのでしょうがない現象なのですが、詰める時に、どうしても日付だけはそのままにして上に詰めたいのです。そんなことは可能でしょうか・・
- ベストアンサー
- オフィス系ソフト
エクセル　数値結果の値によって日付を入れたい
シート2の2列目にOKが入ると、シート１のC列にOKが入り、更新された日がB列に表示されるようにしたいです。 C列に手入力でOKと入力すればB列に日付が表示されるのですが、C列をVLOOKで呼ぶようにしたら表示されなくなってしまいました。どのように修正していいのか分かりません。お教えいただければと思います。よろしくお願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Dim TgRng As Range Set TgRng = Intersect(Range("C1:C2000"), Target) If Not TgRng Is Nothing Then Application.EnableEvents = False For Each Rng In TgRng If Rng.Value = "OK" Then Rng.Offset(, -1).Value = Date End If Next Application.EnableEvents = True End If Set TgRng = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
日付入力マクロ
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日と表示されるようにすることは可能ですか？
- ベストアンサー
- オフィス系ソフト
日付を増やすのは無理なのでしょうか？
いろいろ指導していただき　解決したと思ったらまた振り出しに戻ってしまいました。 N3が終了と表示されたら　A列に　5／3が表示できるようにしたい(＋１日後) B列が毎週なら、A列は(＋７日後)を表示したい現在　下記のような計算式が入っているのですが、動作しません。その理由として、 N列には=IF(I1>0,"終了","未着手") B列は　プルダウンで　=$B$8:$B$9から選ぶようにしていますつまり、I列によって　自動的に、終了か、着手が決まっています。 B列は私が手動でプルダウンで２つのいずれかを選んでいます。このような計算式が入っていると下記のやり方では無理らしいのですが結局　マクロを使う以外日付を増やすのは無理なのでしょうか？そしてマクロを使うには、数式が入っていると作動しないのでしょうか？－－－－－－－－－－－－－エクセルのシート名タブを右クリックしてコードの表示－現れたシートに下記をコピー貼り付けています Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim h As Range On Error Resume Next For Each h In Application.Intersect(Target, Range("N:N")) If h = "終了" Then If h.Offset(0, -12) = "毎日" Then h.Offset(0, -13) = h.Offset(0, -13) + 1 ElseIf h.Offset(0, -12) = "毎週" Then h.Offset(0, -13) = h.Offset(0, -13) + 7 End If End If Next End Sub
- ベストアンサー
- オフィス系ソフト
Excel VBA 入力規則
入力規則を利用して、３つのセルを連携させることを考えていますが、不適合な値を張り付けらられた場合に拒否をする方法があるのでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ad As String Dim ma As Range Dim ma2 As Range Dim r As Range Dim r2 As Range Dim r3 As Range Dim r1 As Range Dim m As Long Dim m2 As Long Application.EnableEvents = False If Target = "" Then Range("F7").Validation.Delete Range("F7") = "" If Target.Address(0, 0) = "B7" Then Range("D7").Validation.Delete Range("D7") = "" End If GoTo EXIT_SUB End If With Worksheets("Sheet1") ad = "A4" Set r = .Range(ad) Set ma = r.MergeArea Set r1 = r.Offset(0, 1) m = Application.Match(Range("B7"), .Range(r1, .Cells(r.Row + ma.Count - 1, r1.Column)), 0) Set r2 = .Cells(r.Row + m - 1, r1.Column) Set ma2 = r2.MergeArea If Target.Address(0, 0) = "B7" Then If ma.MergeCells Then setValiS Target.Offset(0, 2), r2 Range("F7").Validation.Delete Target.Offset(0, 2) = "" Target.Offset(0, 4) = "" Else MsgBox "A列が連結されていません。" End If ElseIf Target.Address(0, 0) = "D7" Then Set r3 = r2.Offset(0, 1) m2 = Application.Match(Target, .Range(r3, .Cells(r2.Row + ma2.Count - 1, r3.Column)), 0) setValiS Target.Offset(0, 2), .Cells(r2.Row + m2 - 1, r3.Column) Target.Offset(0, 2) = "" End If End With EXIT_SUB: Application.EnableEvents = True End Sub Sub setVali2() Dim tc As Range Dim c As Range Set tc = Worksheets("登録").Range("D3") Set c = Worksheets("Sheet1").Range("C3") setValiS tc, c End Sub Sub setValiS(tc As Range, c As Range) Dim ss As String Debug.Print tc.Address, c.Address ss = getChildren(c) If ss > "" Then With tc.Validation .Delete .Add Type:=xlValidateList, Formula1:=getChildren(c) End With End If Worksheets("登録").Activate End Sub Function getChildren(c As Range) Dim c1 As Range Dim ss As String Dim s1 As String Worksheets("Sheet1").Activate ss = "" For Each c1 In c.MergeArea s1 = c1.Offset(0, 1) If s1 <> "" Then ss = ss & "," & s1 Next c1 If ss <> "" Then ss = Mid(ss, 2) Else MsgBox "データがありません！" End If getChildren = ss End Function Sub Outline() Dim CheckRow As Long Dim Moji As String Dim TopRow As Long Dim EndRow As Long With ActiveSheet .Range("A2").ClearOutline .Outline.SummaryRow = xlAbove CheckRow0 = .Range("A" & .Rows.Count).End(xlUp).Row CheckRow = CheckRow0 Do If Moji = "" Then Moji = .Cells(CheckRow, 1).Value EndRow = CheckRow ElseIf yy_mm(CDate(.Cells(CheckRow, 1).Value)) = yy_mm(CDate(Moji)) Then TopRow = CheckRow If TopRow = 1 Then .Rows(TopRow + 1 & ":" & EndRow).Rows.Group Exit Do End If Else .Rows(TopRow + 1 & ":" & EndRow).Rows.Group CheckRow = CheckRow + 1 Moji = "" End If CheckRow = CheckRow - 1 Loop Until CheckRow = 1 .Rows(CheckRow + 1 & ":" & EndRow).Rows.Group .Outline.ShowLevels RowLevels:=1 ExecuteExcel4Macro "SHOW.DETAIL(1," & CheckRow0 & ",TRUE)" End With End Sub Function yy_mm(d As Date) yy_mm = Format(d, "yy/mm") End Function
- 締切済み
- その他（プログラミング・開発）
エクセル　ダブルクリックで処理日の入力
お世話になります。先般、お教え頂きました別のダブルクリックイベントプロシージャと下記の当日の日付を入力するという処理を同じシート上で行いたいのですが、ＶＢエディターにどのように記述したら良いかわかりません。当方、かなりの初心者です。よろしくご教授くださいませ。【新しく加えたい処理】 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("b4:C999")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Date Cancel = True End If End Sub 【もともと使っている処理】 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("h1:h999")) Is Nothing Then With Target If .Value = "" Then .Value = "有" ElseIf .Value = "有" Then .Value = "無" ElseIf .Value = "無" Then .Value = "" End If End With ElseIf Not Intersect(Target, Range("i1:i999")) Is Nothing Then With Target If .Value = "" Then .Value = "要" ElseIf .Value = "要" Then .Value = "不要" ElseIf .Value = "不要" Then .Value = "" End If End With End If End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
エクセルVBAで重複入力の排除
すでに入力規則はリストで使用しております。そのためVBAで重複入力の排除を行おうと思います。一応以下のコードでできたのですが、もっと良い方法があったら教えてください。お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) 　　 Dim myDic As Object 　　 Dim c As Variant, varData As Variant 　　 Dim i As Long 　　 If Application.Intersect(Target, Range("A1:A50")) Is Nothing Then Exit Sub 　　 Set myDic = CreateObject("Scripting.Dictionary") 　　 varData = Range("A1:A50").Value 　　 For Each c In varData 　　　　 If Not c = Empty Then 　　　　　　 i = i + 1 　　　　　　 If Not myDic.Exists(c) Then 　　　　　　　　 myDic.Add c, Null 　　　　　　 End If 　　　　 End If 　　 Next 　　 If myDic.Count < i Then 　　　　MsgBox Target & " は重複！" 　　　　Application.EnableEvents = False 　　　　Application.Undo 　　　　Application.EnableEvents = True 　　 End If End Sub
- ベストアンサー
- Excel（エクセル）

Excel VBAで日付の入力と日数計算を行う方法

1380649874335の回答

お礼 2012/04/06 13:17

関連するQ&A

注目のQ&A

カテゴリ
一覧

専門家に質問してみよう
専門家登録

Excel VBAで日付の入力と日数計算を行う方法

1380649874335の回答

お礼 2012/04/06 13:17

関連するQ&A

注目のQ&A

カテゴリ 一覧

専門家に質問してみよう 専門家登録

カテゴリ
一覧

専門家に質問してみよう
専門家登録