Excel簡単入力

質問

A　　　　　B　　　　　C　　　　　D
1　　日付　　　部門　　　支店　　　　氏名　　　金額
2　　21/12/1　 製造　　　東京　　　　山田　　　1000
3　　21/12/3 　営業　　　大阪　　　　宮崎　　　 500

上セルと同一内容を簡単に入力する際、Ctrl キー+Shift+"で上セルの内容をコピーし編集状態になりEnterで確定しますよね？それをもっと簡単に空白セルの時Enterで上セルをコピーし編集状態でもう一度Enterで確定というマクロを組みたいので教えてください。初心者です。

なお、皆さんに教えてもらってA1:A600まで以下のマクロを設定し正常に動作しています。
Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
Dim r As Range
Dim flg As Long
flg = 0
If Intersect(Target, Range("A4:A600")) 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 >= 101 And .Value <= 1111231 Then
b = Str(Val(Left(.Value, 2)) + 1988) & "/" & Mid(.Value, 3, 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

どうかよろしくお願いします。

回答No.2

watabe007 · ベストアンサー

>Enterキーを2回押す方法が良いのです。
それならOnKeyメソッドを使う方法が有ります
Openイベントで実行するのが良いでしょう
Private Sub Workbook_Open()
　　Application.OnKey "{~}", "エンターキーで実行"
　　'テンキーのEnterで実行
Application.OnKey "{Enter}", "エンターキーで実行"
End Sub
'閉じるときにエンターキーへの割り当て解除
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Application.OnKey "{~}"
Application.OnKey "{Enter}"
End Sub

'===== 標準モジュール====
Dim myAdd As String

Sub エンターキーで実行()
　　With ActiveCell
　　　　'空白セルでなければExit
　　　　If .Value <> "" Then Exit Sub
　　　　'一行目であればExit
　　　　If .Row = 1 Then Exit Sub
　　　　If .Address = myAdd Then
　　　　　　.Value = .Offset(-1).Value
　　　　　　myAdd = ""
　　　　Else
　　　　　　myAdd = .Address
　　　　End If
　　End With
End Sub

お礼

教えていただいてありがとうございます。
しかしながら動作しません。初心者ですのでどこを直せばよいか、
もしくは、私の設定の仕方が悪いのかすらわかりません。
どうしようもない私ですがもう少し詳しく教えてください。

回答No.4

KenKen_SP

通常、Enter キーはよく使われるキーのひとつですから、その特殊な
キーにマクロを割り当てるのは非常にリスキーです。

せめて、Shift ＋ Enter など装飾キーを併用して下さい。

下記ソースを ThisWorkbook モジュールを貼り付け、保存後、一度
ファイルを閉じて、それから開き直してみてください。

Shift + Enter で直前行のデータをコピーします。Excel 固有の機能
をキーシミュレートで呼び出しているだけなので、アンドゥ機能が
使えますし、例外処理も不要です。で、あえて SendKeys。

　# マクロを実行するとアンドゥできなくなることを承知して
　# おいた方が良いですよ。本当に必要か？ と良く検討して
　# 下さい。一応他ブックには影響しないようにしておきました。

Private Sub Workbook_Open()
　　Application.OnKey "+~", "ThisWorkbook.CopyPrevRow"
　　Application.OnKey "+{ENTER}", "ThisWorkbook.CopyPrevRow"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Application.OnKey "+~"
　　Application.OnKey "+{ENTER}"
End Sub

Private Sub CopyPrevRow()
　　If ActiveWorkbook Is ThisWorkbook Then
　　　　SendKeys "^+2{ENTER}"
　　End If
End Sub

回答No.3

watabe007

>しかしながら動作しません。
'====ThisWorkbookモジュールに記述=======
Private Sub Workbook_Open()
　　'Application.OnKey "{~}", "エンターキーで実行"
　　　　'↓変更してください
　　Application.OnKey "~", "エンターキーで実行"
　　'テンキーのEnterで実行
　　Application.OnKey "{Enter}", "エンターキーで実行"
End Sub
'閉じるときにエンターキーへの割り当て解除
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　'Application.OnKey "{~}"
　　　　'↓変更してください
　　Application.OnKey "~"
　　'テンキーのEnterで実行
　　Application.OnKey "{Enter}"
End Sub

'====標準モジュールに記述=======
Dim myAdd As String '※←標準モジュールの一番上に記述

Sub エンターキーで実行()
　　With ActiveCell
　　　　'空白セルでなければExit
　　　　If .Value <> "" Then Exit Sub
　　　　'一行目であればExit
　　　　If .Row = 1 Then Exit Sub
　　　　If .Address = myAdd Then
　　　　　　.Value = .Offset(-1).Value
　　　　　　myAdd = ""
　　　　Else
　　　　　　myAdd = .Address
　　　　End If
　　End With
End Sub

以上をそれぞれのモジュールにコピーして一度、保存終了して下さい
次に開いたときOpenイベントでOnKeyメソッドが働き動作します。

回答No.1

watabe007

>それをもっと簡単に空白セルの時Enterで上セルをコピーし編集状態でもう一度Enterで確定
もっと簡単にダブルクリック１回で実行してみては
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　With Target
　　　　'空白セルでなければExit
　　　　If .Value <> "" Then Exit Sub
　　　　'一行目であればExit
　　　　If .Row = 1 Then Exit Sub
　　　　.Value = .Offset(-1).Value
　　End With
　　Cancel = True
End Sub

お礼

早速の回答ありがとうございました！！！
しかしながら、マウスの操作を一切しないような環境ですので、
Enterキーを2回押す方法が良いのです。