こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

投稿日時 - 2007-04-20 15:05:27

QNo.2935925

困ってます

質問者が選んだベストアンサー

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

(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

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

投稿日時 - 2007-04-23 11:20:39

補足

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

投稿日時 - 2007-04-23 13:48:14

ANo.11

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(18)

ANo.18

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

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

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

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


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

投稿日時 - 2007-04-25 09:53:17

お礼

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

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

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

投稿日時 - 2007-04-25 15:28:14

ANo.17

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

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

投稿日時 - 2007-04-24 13:44:36

補足

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

投稿日時 - 2007-04-25 13:47:55

ANo.16

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

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

投稿日時 - 2007-04-24 09:06:03

補足

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

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

投稿日時 - 2007-04-24 12:56:13

ANo.15

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

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

投稿日時 - 2007-04-23 18:33:24

補足

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

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

投稿日時 - 2007-04-23 20:48:00

ANo.14

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

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

投稿日時 - 2007-04-23 17:17:15

補足

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

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

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

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

投稿日時 - 2007-04-23 20:26:54

ANo.13

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

投稿日時 - 2007-04-23 16:24:23

補足

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

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

投稿日時 - 2007-04-23 16:55:38

ANo.12

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

Public ForCursor As Range

投稿日時 - 2007-04-23 15:11:37

補足

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に書かれてる文字です。

投稿日時 - 2007-04-23 16:05:02

ANo.10

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

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

投稿日時 - 2007-04-22 14:12:18

補足

ありがとうございます。
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
という順番なのですけど(矢印の間は省略しています。)

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

投稿日時 - 2007-04-22 16:57:27

ANo.9

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

ファイル -> 閉じる

投稿日時 - 2007-04-22 09:09:48

補足

pkh4989 さん ありがとうございます。
Sub 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

投稿日時 - 2007-04-22 13:23:26

ANo.8

すみません。入力セルのロックを外すのを忘れました。
以下のモジュールを再度設定して、行って下さい。

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

投稿日時 - 2007-04-21 20:58:03

補足

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

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

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

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

投稿日時 - 2007-04-22 08:35:10

ANo.7

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

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

投稿日時 - 2007-04-21 19:47:28

ANo.6

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

Sub Auto_Open()
Sub Macro1()

投稿日時 - 2007-04-21 19:43:32

ANo.5

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

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

投稿日時 - 2007-04-21 15:34:41

補足

入力をクリックすると、記入するセルが黄色になり、
何も記入できなくなりました。
モジュール 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

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

投稿日時 - 2007-04-21 16:58:25

ANo.4

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

シート上に「入力」と「解除」ボタンを作ります。
(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

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

こんな感じでしょうね。

投稿日時 - 2007-04-20 23:19:48

補足

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

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

投稿日時 - 2007-04-21 13:09:59

ANo.3

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

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

投稿日時 - 2007-04-20 15:53:16

補足

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

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

こんな感じです。

投稿日時 - 2007-04-20 16:21:35

ANo.2

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

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

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

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

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

投稿日時 - 2007-04-20 15:49:32

補足

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

投稿日時 - 2007-04-20 15:59:36

ANo.1

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

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

投稿日時 - 2007-04-20 15:44:01

補足

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

投稿日時 - 2007-04-20 15:53:17

あなたにオススメの質問