エクセルでこまっています。

質問

友達から頼まれて、エクセルで報告書を作っているのですけど。
記入したいセルに、　記入　enter 記入 enter ・・・
という具合に、キーボードだけで、記入できるマクロのプログラムを
教えていただきたいのですが、お願いします。

過去の質問を見ても解決しませんでした。
マクロの記録　を　使って、Ctrl +　セルクリック　で　順番に書き込める
ようにはなったのですけど、　選択したセルが、記入するセル以外青くなり
見栄えが悪いのです。
この　青がなくなるようにできませんでしょうか？

回答No.11

pkh4989 · ベストアンサー

大変失礼しました。
入力に順番を考えなかったので、すみません。
以下は、修正モジュールです。とりあえず、急いで作りましたので、モジュールが長いです。

(1) まず、以下のモジュールを「標準モジュール」へ入れ替えてください。(前のモジュールを全て削除)

Public ForCursor As Range

Sub 入力設定()
Application.EnableEvents = False
ActiveSheet.Unprotect
Union(Range( _
"S22:W23,M26:R26,S26:W26,D7:I7,C8:I8,E9:I9,C10:I13,C14:I15,C16:I17,C18:K19,C20:K22,C23:K24,C25:K26,C27:K27,C28:K28,C29:K29,E30:K30,C31:H32,D35:F36,H35:I36,K6:P7,K10:M11,K12:P14,Q11:Q12,S11:S12,U11:U12,S14,U14,W11:W14,J17,L17,S17" _
), Range("U17,M19:R20,S19:W20,M22:R23")).Select
Selection.Interior.ColorIndex = xlNone
Selection.Locked = False 'ロックを外す
Selection.ClearContents '入力セルのみクリア
ActiveSheet.EnableSelection = xlUnlockedCells
Range("D7").Select
Set CurCursor = Selection(1)
Application.EnableEvents = True
End Sub

Sub 入力_click()
Call 入力設定
ActiveSheet.Protect
End Sub

Sub 解除_click()
ActiveSheet.Unprotect
End Sub

(2) 次のモジュールは、「標準モジュール」の上に「Microsoft Excel Objects」があると思います。そのなかに、「Sheet1～」があるので、そのなかで、入力シートを選んでマウス右Clickして「コードの表示」を選択してください。
右側に、コードを入れるシートが表示されるので、以下のモジュールを貼り付けてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Row = 7 And Target.Column = 11 Then
If ForCursor.Row = 7 And ForCursor.Column = 9 Then
Set ForCursor = ActiveSheet.Cells(8, 3)
ForCursor.Select
End If
End If
If Target.Row = 10 And Target.Column = 11 Then
If ForCursor.Row = 10 And ForCursor.Column = 9 Then
Set ForCursor = ActiveSheet.Cells(11, 3)
ForCursor.Select
End If
End If
If Target.Row = 11 And Target.Column = 11 Then
If ForCursor.Row = 11 And ForCursor.Column = 9 Then
Set ForCursor = ActiveSheet.Cells(12, 3)
ForCursor.Select
End If
End If
If Target.Row = 12 And Target.Column = 11 Then
If ForCursor.Row = 12 And ForCursor.Column = 9 Then
Set ForCursor = ActiveSheet.Cells(13, 3)
ForCursor.Select
End If
End If
If Target.Row = 13 And Target.Column = 11 Then
If ForCursor.Row = 13 And ForCursor.Column = 9 Then
Set ForCursor = ActiveSheet.Cells(14, 3)
ForCursor.Select
End If
End If
If Target.Row = 14 And Target.Column = 11 Then
If ForCursor.Row = 14 And ForCursor.Column = 9 Then
Set ForCursor = ActiveSheet.Cells(15, 3)
ForCursor.Select
End If
End If
If Target.Row = 17 And Target.Column = 10 Then
If ForCursor.Row = 17 And ForCursor.Column = 9 Then
Set ForCursor = ActiveSheet.Cells(18, 3)
ForCursor.Select
End If
End If
If Target.Row = 19 And Target.Column = 13 Then
If ForCursor.Row = 19 And ForCursor.Column = 11 Then
Set ForCursor = ActiveSheet.Cells(20, 3)
ForCursor.Select
End If
End If
If Target.Row = 20 And Target.Column = 13 Then
If ForCursor.Row = 20 And ForCursor.Column = 11 Then
Set ForCursor = ActiveSheet.Cells(21, 3)
ForCursor.Select
End If
End If
If Target.Row = 22 And Target.Column = 13 Then
If ForCursor.Row = 22 And ForCursor.Column = 11 Then
Set ForCursor = ActiveSheet.Cells(23, 3)
ForCursor.Select
End If
End If
If Target.Row = 23 And Target.Column = 13 Then
If ForCursor.Row = 23 And ForCursor.Column = 11 Then
Set ForCursor = ActiveSheet.Cells(24, 3)
ForCursor.Select
End If
End If
If Target.Row = 26 And Target.Column = 13 Then
If ForCursor.Row = 26 And ForCursor.Column = 11 Then
Set ForCursor = ActiveSheet.Cells(27, 3)
ForCursor.Select
End If
End If
If Target.Row = 35 And Target.Column = 8 Then
If ForCursor.Row = 35 And ForCursor.Column = 6 Then
Set ForCursor = ActiveSheet.Cells(36, 4)
ForCursor.Select
End If
End If
If Target.Row = 36 And Target.Column = 8 Then
If ForCursor.Row = 36 And ForCursor.Column = 6 Then
Set ForCursor = ActiveSheet.Cells(35, 8)
ForCursor.Select
End If
End If
If Target.Row = 36 And Target.Column = 4 Then
If ForCursor.Row = 35 And ForCursor.Column = 9 Then
Set ForCursor = ActiveSheet.Cells(36, 8)
ForCursor.Select
End If
End If
'---------------------------------------------------------------
If Target.Row = 7 And Target.Column = 4 Then
If ForCursor.Row = 6 And ForCursor.Column = 16 Then
Set ForCursor = ActiveSheet.Cells(7, 11)
ForCursor.Select
End If
End If
If Target.Row = 8 And Target.Column = 3 Then
If ForCursor.Row = 7 And ForCursor.Column = 16 Then
Set ForCursor = ActiveSheet.Cells(10, 11)
ForCursor.Select
End If
End If
If Target.Row = 11 And Target.Column = 3 Then
If ForCursor.Row = 10 And ForCursor.Column = 13 Then
Set ForCursor = ActiveSheet.Cells(11, 11)
ForCursor.Select
End If
End If
If Target.Row = 11 And Target.Column = 17 Then
If ForCursor.Row = 11 And ForCursor.Column = 13 Then
Set ForCursor = ActiveSheet.Cells(12, 11)
ForCursor.Select
End If
End If
If Target.Row = 12 And Target.Column = 17 Then
If ForCursor.Row = 12 And ForCursor.Column = 16 Then
Set ForCursor = ActiveSheet.Cells(13, 11)
ForCursor.Select
End If
End If
If Target.Row = 13 And Target.Column = 23 Then
If ForCursor.Row = 13 And ForCursor.Column = 16 Then
Set ForCursor = ActiveSheet.Cells(14, 11)
ForCursor.Select
End If
End If
If Target.Row = 14 And Target.Column = 19 Then
If ForCursor.Row = 14 And ForCursor.Column = 16 Then
Set ForCursor = ActiveSheet.Cells(11, 17)
ForCursor.Select
End If
End If
If Target.Row = 11 And Target.Column = 19 Then
'If (ForCursor.Row = 11 And ForCursor.Column = 17) Or
If (ForCursor.Row = 14 And ForCursor.Column = 19) Then
Set ForCursor = ActiveSheet.Cells(12, 17)
ForCursor.Select
End If
End If
If Target.Row = 12 And Target.Column = 19 Then
If ForCursor.Row = 11 And ForCursor.Column = 19 Then
Set ForCursor = ActiveSheet.Cells(11, 19)
ForCursor.Select
End If
End If
If Target.Row = 11 And Target.Column = 21 Then
If ForCursor.Row = 12 And ForCursor.Column = 19 Then
Set ForCursor = ActiveSheet.Cells(12, 19)
ForCursor.Select
End If
End If
If Target.Row = 12 And Target.Column = 21 Then
If ForCursor.Row = 11 And ForCursor.Column = 21 Then
Set ForCursor = ActiveSheet.Cells(11, 21)
ForCursor.Select
End If
End If
If Target.Row = 11 And Target.Column = 23 Then
If ForCursor.Row = 12 And ForCursor.Column = 21 Then
Set ForCursor = ActiveSheet.Cells(12, 21)
ForCursor.Select
End If
End If
If Target.Row = 12 And Target.Column = 23 Then
If ForCursor.Row = 11 And ForCursor.Column = 23 Then
Set ForCursor = ActiveSheet.Cells(14, 19)
ForCursor.Select
End If
End If
If Target.Row = 14 And Target.Column = 23 Then
If ForCursor.Row = 14 And ForCursor.Column = 21 Then
Set ForCursor = ActiveSheet.Cells(11, 23)
ForCursor.Select
End If
End If
'
If Target.Row = 12 And Target.Column = 3 Then
If ForCursor.Row = 14 And ForCursor.Column = 23 Then
Set ForCursor = ActiveSheet.Cells(12, 23)
ForCursor.Select
End If
End If
If Target.Row = 13 And Target.Column = 3 Then
If ForCursor.Row = 12 And ForCursor.Column = 3 Then
Set ForCursor = ActiveSheet.Cells(13, 23)
ForCursor.Select
End If
End If
If Target.Row = 14 And Target.Column = 3 Then
If ForCursor.Row = 13 And ForCursor.Column = 3 Then
Set ForCursor = ActiveSheet.Cells(14, 23)
ForCursor.Select
End If
End If
If Target.Row = 15 And Target.Column = 3 Then
If ForCursor.Row = 14 And ForCursor.Column = 3 Then
Set ForCursor = ActiveSheet.Cells(17, 10)
ForCursor.Select
End If
End If
If Target.Row = 18 And Target.Column = 3 Then
If ForCursor.Row = 17 And ForCursor.Column = 21 Then
Set ForCursor = ActiveSheet.Cells(19, 13)
ForCursor.Select
End If
End If
If Target.Row = 20 And Target.Column = 3 Then
If ForCursor.Row = 19 And ForCursor.Column = 23 Then
Set ForCursor = ActiveSheet.Cells(20, 13)
ForCursor.Select
End If
End If
If Target.Row = 21 And Target.Column = 3 Then
If ForCursor.Row = 20 And ForCursor.Column = 23 Then
Set ForCursor = ActiveSheet.Cells(22, 13)
ForCursor.Select
End If
End If
If Target.Row = 23 And Target.Column = 3 Then
If ForCursor.Row = 22 And ForCursor.Column = 23 Then
Set ForCursor = ActiveSheet.Cells(23, 13)
ForCursor.Select
End If
End If
If Target.Row = 24 And Target.Column = 3 Then
If ForCursor.Row = 23 And ForCursor.Column = 23 Then
Set ForCursor = ActiveSheet.Cells(26, 13)
ForCursor.Select
End If
End If
If Target.Row = 27 And Target.Column = 3 Then
If ForCursor.Row = 26 And ForCursor.Column = 23 Then
Set ForCursor = ActiveSheet.Cells(7, 4)
ForCursor.Select
End If
End If
Set ForCursor = Target
Application.EnableEvents = True
End Sub

終りましたら、一旦、ブックを保存・終了、再度ブックを開いてから試してみてください。

補足

こんな長いプログラム大変だったのではないですか？ありがとうございます。
ブックを保存、終了、してから開いて。入力キーを実行すると、
Enterキーを押した直後、実行時エラー’424’：
オブジェクトが必要です　と
出て,Enterを押すと、　If ForCursor.Row = 7 And ForCursor.Column = 16 Then　が黄色の太い線で塗られます。
どうすればよいでしょうか。
標準モジュール　＝　ThisWorkbook　でよろしいのでしょうか？初心者で
すいません。

回答No.7

pkh4989

後、入力セルの色が必要なければ、SUB 入力設定()　の以下の３行を削除してください。

With Selection.Interior
.ColorIndex = 6 '黄色
End With

回答No.6

pkh4989

以下のモジュールはいりませんので、一旦削除(コメント)してから保存し、ブックをクローズして、再度ブックを開いてから行ってください。

Sub Auto_Open()
Sub Macro1()

回答No.5

pkh4989

それでは、
入力セルの色を変えましょう(黄色) -> まわりの色が分かりませんので
同じ色があるなら変えてください。
クリアも入力セルのみしました。

Sub 入力設定()
Union(Range( _
"S22:W23,M26:R26,S26:W26,D7:I7,C8:I8,E9:I9,C10:I13,C14:I15,C16:I17,C18:K19,C20:K22,C23:K24,C25:K26,C27:K27,C28:K28,C29:K29,E30:K30,C31:H32,D35:F36,H35:I36,K6:P7,K10:M11,K12:P14,Q11:Q12,S11:S12,U11:U12,S14,U14,W11:W14,J17,L17,S17" _
), Range("U17,M19:R20,S19:W20,M22:R23")).Select
With Selection.Interior
.ColorIndex = 6 '黄色
End With
Selection.ClearContents '入力セルのみクリア
ActiveSheet.EnableSelection = xlUnlockedCells
Range("D7").Select
End Sub

Sub 入力_click()
Call 入力設定
ActiveSheet.Protect
End Sub

Sub 解除_click()
ActiveSheet.Unprotect
End Sub

補足

入力をクリックすると、記入するセルが黄色になり、
何も記入できなくなりました。
モジュール　1　への入れ方がいけないのでしょうか？

Sub Auto_Open()
ActiveSheet.OnDoubleClick = "Macro1"
End Sub

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2007/4/19 ユーザー名 : 既定
'

'
Union(Range( _
"S22:W23,M26:R26,S26:W26,D7:I7,C8:I8,E9:I9,C10:I13,C14:I15,C16:I17,C18:K19,C20:K22,C23:K24,C25:K26,C27:K27,C28:K28,C29:K29,E30:K30,C31:H32,D35:F36,H35:I36,K6:P7,K10:M11,K12:P14,Q11:Q12,S11:S12,U11:U12,S14,U14,W11:W14,J17,L17,S17" _
), Range("U17,M19:R20,S19:W20,M22:R23")).Select
Range("D7").Activate
End Sub

Sub 入力設定()
Union(Range( _
"S22:W23,M26:R26,S26:W26,D7:I7,C8:I8,E9:I9,C10:I13,C14:I15,C16:I17,C18:K19,C20:K22,C23:K24,C25:K26,C27:K27,C28:K28,C29:K29,E30:K30,C31:H32,D35:F36,H35:I36,K6:P7,K10:M11,K12:P14,Q11:Q12,S11:S12,U11:U12,S14,U14,W11:W14,J17,L17,S17" _
), Range("U17,M19:R20,S19:W20,M22:R23")).Select
With Selection.Interior
.ColorIndex = 6 '黄色
End With
Selection.ClearContents '入力セルのみクリア
ActiveSheet.EnableSelection = xlUnlockedCells
Range("D7").Select
End Sub

Sub 入力_click()
Call 入力設定
ActiveSheet.Protect
End Sub

Sub 解除_click()
ActiveSheet.Unprotect
End Sub

これ　入れ方へんですか?（初心者ですいません。）
それと、黄色ではなく　無色がいいのですけどできませんか？

回答No.4

pkh4989

以下の方法は如何でしょうか？

シート上に「入力」と「解除」ボタンを作ります。
(1)「入力」ボタンのマクロ -> 入力_click
(2)「解除」ボタンのマクロ -> 解除_click
(3)以下のマクロを標準モジュールに設定する

Sub 入力設定()
Union(Range( _
"S22:W23,M26:R26,S26:W26,D7:I7,C8:I8,E9:I9,C10:I13,C14:I15,C16:I17,C18:K19,C20:K22,C23:K24,C25:K26,C27:K27,C28:K28,C29:K29,E30:K30,C31:H32,D35:F36,H35:I36,K6:P7,K10:M11,K12:P14,Q11:Q12,S11:S12,U11:U12,S14,U14,W11:W14,J17,L17,S17" _
), Range("U17,M19:R20,S19:W20,M22:R23")).Select
With Selection.Interior
.ColorIndex = 35
End With
ActiveSheet.Cells.ClearContents
ActiveSheet.EnableSelection = xlUnlockedCells
Range("D7").Select
End Sub

Sub 入力_click()
Call 入力設定
ActiveSheet.Protect
End Sub

Sub 解除_click()
ActiveSheet.Unprotect
End Sub

※入力時に、「入力」ボタンを押してから入力を行う
-> 入力エリアのロックを解除してから「保護」する
※入力が終わったら「解除」ボタンを押してから「○」等を入力する
-> 「保護」を解除する

こんな感じでしょうね。

補足

いろいろ考えていただきありがとうございます。
標準モジュール　1　に　上のプログラムを足してみたところ、
書き込むセルが、まわりで使っている塗りつぶしの色と同じ色に、塗りつぶされてしまいます。

それと、記入するセル以外の　文字が　消えてしまいます。
どうしたらいいでしょうか・・

回答No.3

misatoanna

セルの入力順が左→右優先や上→下優先で、途中で逆戻りしないという
前提でしたら、次のようにすればいいのですが。

1.入力するセルを全て選択してロックを外します。
2.シートタブ上の右クリックメニューからコードの表示を選択し、表示
　される画面左端にあるツリーの ThisWorkbook をダブルクリックして
　次のモジュールを記述します。
　　Private Sub Workbook_Open()
　　ActiveSheet.EnableSelection = xlUnlockedCells
　　End Sub
3.シートを保護して保存します。
入力後のセル移動方向は必要なら指定します。

補足

右クリックしても、コードの表示が出ないんですけど（涙）
マクロの記録　は

Sub Auto_Open()
ActiveSheet.OnDoubleClick = "Macro1"
End Sub

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2007/4/19 ユーザー名 : 既定
'

'
Union(Range( _
"S22:W23,M26:R26,S26:W26,D7:I7,C8:I8,E9:I9,C10:I13,C14:I15,C16:I17,C18:K19,C20:K22,C23:K24,C25:K26,C27:K27,C28:K28,C29:K29,E30:K30,C31:H32,D35:F36,H35:I36,K6:P7,K10:M11,K12:P14,Q11:Q12,S11:S12,U11:U12,S14,U14,W11:W14,J17,L17,S17" _
), Range("U17,M19:R20,S19:W20,M22:R23")).Select
Range("D7").Activate
End Sub

こんな感じです。

回答No.2

nobu555

質問の趣旨は、入力の必要なセルだけ選択移動できればよいのでしょうか?

だとしたら、以下の方法は如何でしょうか。

入力必要セルを全て選択して、
「セルの書式設定」からタブ「保護」で
「ロック」のチェックを外す。

「ツール」「保護」「シートの保護」で
「ロックされたセル範囲の選択」のチェックを外す。

これで、Enterや矢印キーを押すと
ロックを外したセルしか選択できませんが
如何でしょう。

補足

入力　セル　以外にも、　〇を　付けなければいけないので、
だめなんです。どうすればいいでしょうか？

回答No.1

mshr1962

＞選択したセルが、記入するセル以外青くなり
これはエクセルの仕様なのでどうにもなりません。

どうしても見栄えを考えるなら、その選択したセルのみ
セルの書式設定の保護のロックを解除して
「ツール」「シートの保護」を掛けてください。
この状態なら現在のカーソル位置から左→右、上→下（左）とカーソルが動きます。

補足

忙しい中　ありがとうございます。
記入するセル以外にも　〇　を　付けたり　しなければいけないので
出来ないのです・・・どうにかなりませんか？