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

質問

友達から頼まれて、エクセルで報告書を作っているのですけど。
記入したいセルに、　記入　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.18

pkh4989

<ボタンの作成方法>
1. 表示 -> ツールバー -> フォーム -> ボタンを選択 -> 入力シート上に貼り付ける(+ が表示されるのでマルスで適当にサイズを範囲設定)
-> 自動的にマクロ画面が表示されるので、入力ボタンの場合は 「入力_click」を選択して「OK」を押す。
※ ボタンからマクロを登録する時は、ボタンをマウス右Click -> マクロ登録 -> マクロ画面が表示されるので、上記と同様に設定する

<ボタン名の変更>
1. ボタンをマウス右Click -> テキストの編集

後、気になるところがあるので、以下の行を追加して、再度試してみて下さい。

Sub 入力設定()
Application.EnableEvents = False
ActiveSheet.Unprotect
ActiveSheet.Cells.Locked = True '<---これを追加

※ ちなみに、EXCEL2000でも問題なく動きます。
どうしても駄目なら、知ってる方に見て貰った方がいいと思います。
頑張ってください。(^_^;)

お礼

pkh4989　さん　ありがとうございます。
マクロの実行ボタン　作れました。でもダメでした。
作った表が悪いのかと思い、　新しいエクセルのSheetでセルを結合しただけの物でやってみましたが、同じ所からだめでした。

たぶん自分があまりにも初心者でちょっとした間違えに気づかす、だめだだめだと言っているだけなのかもしれません。

でも　pkh4989　さんに作ってもらったプログラム絶対むだにしません。
勉強もしないで、作ってもらおうと思った考えがいけなかったんだと思います。　これからは、本で勉強しながら、このプログラムを使えるようにします。
今まで、こんなに長い回答　本当にありがとうございました。
また違う悩みができた時、pkh4989さん　その時またまたお願いしたいのですが・・・（いやでしょうか（笑））
お元気で！　ヽ(^。^)ノ

回答No.17

pkh4989

やはり 「On Error Resume Next 」は駄目ですね。
「On Error Resume Next 」は削除してください。

確認したいのですが、「入力」「解除」ボタンは作りましたか？
入力時に、「入力」ボタンを押してから入力したのですか？
(1)「入力」ボタンのマクロ -> 入力_click
(2)「解除」ボタンのマクロ -> 解除_click
になっていますか？--> 再度リンクを確認してください。
※ 「入力」ボタンを押すと、入力_clickのモジュールから「入力設定」をCallする(実行)ようになっています。

補足

pkh4989 さん　こんにちは。
On Error Resume Next 削除しました。
今まで　
表示　→　ツールバー　→　VisualBasic　で出てくる　三角ボタン（マクロの実行）を押して　マクロ名を入力clickにして実行してました。

回答No.16

pkh4989

それでは、以下の1行を追加してみてください。

Sheet1の方です。
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error Resume Next '<------これを追加
Application.EnableEvents = False

補足

pkh4989　さん　こんにちは。
Sheet1の2行目に　　On Error Resume Next '　入れました。
エラーは、無くなったのですが、E30:K30　から　H35:I36　に飛んで
記入するセルの範囲の中　一定の規則で動きます。（上下に何回もセルを移動しながら、右に移動して行く感じです。

操作の仕方が悪いのでしょうか。
シート保護の解除　とか　シートを保護　してみたりしたのですけど同じでした。マクロ名　の中に　入力設定　とあるのですが、コレは実行しなくてもよいのですか？

回答No.15

pkh4989

ここまできたので、このVBAで使えるようにしてあげたいのです。
ちなみに、このモジュールはEXCEL2003で作りましたが、問題なく動きます。
多分EXCEL2000でも問題ないと思います。
>やはり実行時エラー’91’が出ました。
については、「オブジェクト変数またはwithブロック変数が設定されていない時」でるエラーメッセージなので、
考えられるのは、標準モジュールなかの「Set CurCursor = Selection(1)」かな？
不要な行なので、そのままでもエラーはでないと思いますが、念の為に削除してください。

※ 入力順番は、選択したセルが、青くなった状態で入力してみて、その順番と同じように制御しました。

補足

本当にありがとうございます。
pkh4989　さんが問題なく動くのになぜ私は動かないのでしょうか。
表だけの状態のエクセルに、作っていただいたモジュールを　標準モジュール　と　Sheet1　に張り付けているのですけど・・

、なぜでしょう。　お手数かけてすいません。

回答No.14

pkh4989

標準モジュールを追加するには、
'(1) Alt+F11 (ツール -> マクロ -> Visual Basic Editor)
'(2) 挿入 -> 標準モジュール です

後、以下のエラー場所を教えて下さい。
>やはり実行時エラー’91’が出ました。

補足

標準モジュール　出せました。ありがとうございます。

やはり、エラーでます。　91です。
Sheet　1　のまん中くらいの位置で

If ForCursor.Row = 7 And ForCursor.Column = 16 Then

これが黄色に囲まれるのですけど、何故なんでしょうか。

回答No.13

pkh4989

ThisWorkbookではありません。
標準モジュールの下に「Module1」とかあると思いますので、そこに貼り付けてください。
ThisWorkbookにあるモジュールは削除してください。

補足

ThisWorkbookのモジュールを削除して、やっと探したModule1に張り付けました。Module1を表示するには、マクロの記録を記録してからじゃないと
Module1が表示されません。エクセル2000だからでしょうか？

やはり実行時エラー’91’が出ました。

回答No.12

pkh4989

標準モジュールの一番上に以下の定義を追加しましたか？

Public ForCursor As Range

補足

pkh4989 さんこんにちは。
Thisworkbookの初めには、　Public ForCursor As Range　と　書いてありました。

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

Thisworkbookに書かれてる文字です。

回答No.10

pkh4989

削除というのは、以下のモジュール全てです。
私が作ったモジュール以外は全て、必要ありません。

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

補足

ありがとうございます。
ThisWorkbook　にコピーしてエラーなくなりました。

ただ　D7:I7　から始まって　E30:K30　までは順調なのですが、
E30:K30　から　H35:I36　へ　飛んでしまい、その後は同じセルを
何回も行き来しながら進んでいく感じです。

D7:I7　から始まり　S26：W26　までのループで順番どうりに　1セル
1回づつ　Enter　で進む事はできませんでしょうか？
D7:I7　→　S17　→　U17　→　M22:R23　→　S22:W23　→　S26:W26
という順番なのですけど（矢印の間は省略しています。）

おかげ様で、記入セル以外の色も無色になって、後　セルの移動の順番
だけになりました。いろいろお考えいただきありがとうございます。

回答No.9

pkh4989

>ブックのクローズが良くわかりません。どうすればよいのですか？
普通にEXCELを終了すればいいです。

ファイル -> 閉じる

補足

pkh4989　さん　ありがとうございます。
Ｓub Auto_Open() と　Sub Macro　1（）　を削除して、
名前を付けて保存、いったん消して　保存したのを呼び出して
Macroを有効にする　を押すと　コンパイルエラーが出るのですけど、
どうしたらいいのですか？

　　　　　　　　　　（　この部分が黒く塗りつぶされます。）
　　　　　　　　　　　　　　　　　　　　↓
ActiveSheet.OnDoubleClick = "Macro1"
End Sub

'
' 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.8

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
Selection.Interior.ColorIndex = xlNone
Selection.Locked = False 'ロックを外す
Selection.ClearContents '入力セルのみクリア
ActiveSheet.EnableSelection = xlUnlockedCells
Range("D7").Select
End Sub

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

Sub 解除_click()
ActiveSheet.Unprotect
End Sub

補足

返事遅くなってすいません。
＞一旦削除(コメント)してから保存し、ブックをクローズして、再度ブックを開いてから行ってください。

削除してから、名前を付けて保存したのですけど、ブックのクローズが
良くわかりません。どうすればよいのですか？

あと　入力クリックか　ダブルクリックすると、
　コンパイルエラー　　
　プロシージャの外では無効です。　　と　出て、一番上の"Macro1”が
　黒く塗りつぶされます。　どうしてなんでしょうか。

いろいろ教えていただきありがとうございます。