VBAの修正 Enterを押した後のセル移動について

質問

以前、下記でお世話になった者です。
その節はありがとうございました。

「質問：ExcelでEnterを押したあとの移動先について06-03-07 23:03」
http://oshiete1.goo.ne.jp/qa2014068.html

「質問：No.2014068のつづきです。VBAで困ってます。06/03/09 22:06」
http://oshiete1.goo.ne.jp/qa2018448.html

当時のもので快調に使用できていましたが、社内システムの入れ替えでデータが増えたため、VBA（または関数）の修正をして使い勝手をよくしたいのです。

データシート名：[データ]に下記のコードが入っています。
シートのデータ範囲はA4:Ｊ65536で、I列に製品コードが入っています。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 11 Then
Cells(ActiveCell.Row, 1).Select
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Range("A65536").End(xlUp).Offset(, 0).Select
End If
End Sub

このコードのおかげで「B2でEnterを押すとA列の「あ」が入っているセルに移動」できました。
これを「B2で製品コードを入力してEnterを押すと、データ範囲のI列を検索して該当レコードの行頭にセルが移動する」に変えたいのです。
ただし、I列の製品コードは1レコードにつき1コード（一品一様）ではありますが、現時点ですべてのコードづけが終わっていないためにB2で入力したものが無い確率の方が高いのです。
この場合は「あ」にセルが移動するようにしたいのですが、どのようにしたらよいのでしょうか。

ご回答よろしくお願いします。

回答No.17

Wendy02

こんばんは。Wendy02です。

最初に、そろそろ、お礼側に書いてください。補足側に書くと、ついつい、そのままになってしまいます。お礼側に書いたほうが反応しやすいです。

>結果、結果、どのセルでEnterを押しても、This　Workbook　JumpingMacro　が見つかりませんというメッセージが出ます。

しかし、「JumpingMacro　が見つかりませんというメッセージが出ます。」というのは、前のマクロが残っているということを意味しています。Visual Basic Editor画面で、編集－検索で、「ThisWorkbook.JumpingMacro」という名前を検索して、その部分を削除してください。もし、無ければ、そのブックを一旦終了して、再度オープンすれば、消えているはずです。

新しいマクロ名は、"newJumpMacro"　です。

'標準モジュール
Sub Auto_Open
　Application.OnKey "{Enter}", "newJumpMacro"
　Application.OnKey "{~}", "newJumpMacro
End Sub

も、
Sub newJumpMacro()
　～
End Sub

も、どちらも標準モジュールに入れてください。

>コントロールツールボタンの件ですが、作ったことがないのでよくわかりません。
>コントロールツールボックスのボタンアイコンをクリックしてボタンを作りましたが（見た目が凸型）、ボタンをクリックするごとに待機セルの位置が一行ずつ下がるだけで、本当はどう動作するとコード通りなのか（どうつくるものなのか）わかりませんでした…。

この件は、

http://oshiete1.goo.ne.jp/kotaeru.php3?qid=2876435
この#3 に書いた方法は、コントロールツールのリストボックスへのマクロの取り付け方です。貼り付けた後、ダブルクリックすると、Visual Basic Editor 画面に切り替わります。そして、#15 で書かれてある以下のマクロを使います。入れるのは、一行だけ

　Call newJumpMacro
でよいです。

'データSheet モジュールへ
'-----------------------------
Private Sub CommandButton1_Click()
　Call newJumpMacro
End Sub

'-----------------------------

なお、これは、[Enter] キーで起動するマクロと、共有しても、ぶつかることはありません。

お礼

Wendy02さん、こんばんは。
お返事が遅くなり申し訳ありません。

>最初に、そろそろ、お礼側に書いてください。

そうですね。
私も、Wendy02さんのアドバイスのおかげで解決しました、とお礼のお返事でしめくくりたくて操作しているのですが、うまくいかず、手間取らせていると感じています。

Wendy02さんのアドバイスは的確なのだろうと思います。
受けいれる側の私がうまくいかないのだと思います。
煮詰まると小さな違いにも気づかなくなります。
まだ解決はしていませんが、再度、時間が取れる週末に＃１から読み直してみます。
そのあと締め切ります。

補足

Wendy02さん、こんばんは。
一度お礼に書いてしまったため、書く場所がここしかなかったので、こちらで失礼します。

メッセージはすべて削除して新しく書き込んでも同じ結果になりました。
最初に望んだ解決には至りませんでしたが、Wendy02さんには長い間お力添えをいただきました。
ありがとうございました。

回答No.16

Wendy02

補足：
もし、動くのでしたら、#15 を標準モジュールにおいて、次に、

'標準モジュール
Sub Auto_Open
　Application.OnKey "{Enter}", "newJumpMacro"
　Application.OnKey "{~}", "newJumpMacro
End Sub

を設定して、Auto_Open マクロを実行してみてください。

なお、今まで、登録していたものは、すべて、削除するか、コメントアウトにしてください。

補足

Wendy02さん、こんばんは。
ご回答ありがとうございます。
こちらもExcel2003を使用しています。

昨日からいろいろ切り貼りしていますが、うまくいかないのです。

●This　Workbookはすべて削除した状態で、１）と２）のように貼り付けてみました。

１）データsheetのコードと標準モジュールに貼り付け。
・データsheetに#15のコード（「'コマンドボタン用　～～～　入れ替え版のまえの EndLine:　End Sub　まで」）
・標準モジュールに#16のコード

結果、結果、どのセルでEnterを押しても、This　Workbook　JumpingMacro　が見つかりませんというメッセージが出ます。

２）標準モジュールに貼り付け。
・#15のコード（「'コマンドボタン用　～～～　入れ替え版のまえの EndLine:　End Sub　まで」）
・#16のコード

結果、結果、どのセルでEnterを押しても、This　Workbook　JumpingMacro　が見つかりませんというメッセージが出ます。

●Auto_Open マクロの実行の件ですが、ツールでマクロを実行しましたが何がおこなわれているかよくわかりませんでした。おこなわれていないのかもしれません。
上記の貼り付けがちゃんとできていないからだと思います。

●コントロールツールボタンの件ですが、作ったことがないのでよくわかりません。
コントロールツールボックスのボタンアイコンをクリックしてボタンを作りましたが（見た目が凸型）、ボタンをクリックするごとに待機セルの位置が一行ずつ下がるだけで、本当はどう動作するとコード通りなのか（どうつくるものなのか）わかりませんでした…。

せっかく#15と#16でご回答いただいたのに、どうしていいのかわからないのです。
こちらとWendy02さんとで、コードを貼り付りつけている場所など大いに違うのでは？と思えるのですが、いかがでしょう…。

回答No.15

Wendy02

こんにちは。Wendy02です。

大変遅くになって、申し訳ありません。

Win XP の環境では、
Application.OnKey "{Enter}", "newJumpMacro"
Application.OnKey "{~}", "newJumpMacro"

これが働きません。

>※B2=AAAのときEnterでA4に移動するVBA

いくらやっても、Enterキーで飛ぶマクロは、今の環境では、抜け落ちが生じて、Win XP 上では、Excel2003 でやっても、Excel2000 でやっても解決しないことが判明しました。

さまざまな要因を取り除いたExcelのセーフモードでやっても、同じ現象が出ますので、今の開発環境では、不可能だという結論に達しました。はっきりした原因は不明です。

もう少し、早く発見できればよかったのですが、ご迷惑を掛けてすみません。

>コントロールツールというものを使うと物事がうまく流れるのですね。

それは確かなのですが、今更なのですが、コントロールツールのコマンドボタンで考えてみることにしました。コマンドボタンで作ってみました。これは、ショートカットでも可能です。ご希望のものとは、まったく違うものですが、こういうものしか作れませんでした。

　A　　　 B　　　　　 C
ロット　製品コード　顧客コード
LotData　「111」　　　「AAA」　□　←コマンド・ボタン

B2 のみで、顧客コードを探す場合は、'**　～　'***　を、このコードの下に掲げてあるものに入れ替えてください。

'コマンドボタン用
'--------------------------------------------

'データSheet モジュールへ
Private Sub CommandButton1_Click()
　Call newJumpMacro
End Sub

'--------------------------------------------

'標準モジュール

Private Const SHNAME = "データSheet"　'シート名
Private LastRow As Long

Sub newJumpMacro()
　　Dim i As Long '検索後の行
　　Dim myRange As Variant '配列データ
　　Dim myData As String '配列検索値
　　If ActiveSheet.Name <> SHNAME Then ActiveCell.Offset(1).Select: Exit Sub
　　On Error GoTo EndLine

　　'最終のEnter の起動を、C2 にする
　　'データの最初を4行目とする
　　Const FROW As Integer = 4

　　With Worksheets(SHNAME)
　　　　　　If .Range("B2").Value = "" And .Range("C2").Value = "" Then
　　　　　　　　'両方とも空の場合は、A列の最後のセルにジャンプ
　　　　　　　　.Cells(65536, 1).End(xlUp).Offset(1).Select
　　　　　　　　Exit Sub
　　　　　　End If
　　　　　　LastRow = .Range("A65536").End(xlUp).Row
　　　　　　myRange = .Range("A1").Resize(LastRow).Address & "&" & _
　　　　　　.Range("B1").Resize(LastRow).Address

　　　　　　On Error Resume Next
　　　　　　i = 0

　　　　　 '**
　　　　　　'顧客コードを入れていない場合
　　　　　　If .Range("C2").Value = "" Then
　　　　　　　 i = WorksheetFunction.Match(Cells("B2").Value, .Columns(1), 0)
　　　　　　'製品コードを入れていない場合
　　　　　　ElseIf .Range("C2") <> "" And .Range("B2").Value = "" Then

　　　　　　　　i = WorksheetFunction.Match(Cells("C2").Value, .Columns(2), 0)
　　　　　　ElseIf .Range("C2") <> "" And .Range("B2").Value <> "" Then
　　　　　　　　myData = .Range("B2").Address & "&" & .Range("C2").Address
　　　　　　　　i = Evaluate("Match(" & myData & "," & myRange & ", 0)")
　　　　　　End If　　　　　

　　　　　　If i = 0 Then
　　　　　　　　i = WorksheetFunction.Match(.Range("C2").Value, _
　　　　　　　　.Range("B4").Resize(LastRow), 0) '顧客コードを検索
　　　　　　　　i = i + FROW - 1
　　　　　　　　Application.Goto .Cells(i, 1)
　　　　　　Else
　　　　　　　　Application.Goto .Cells(i, 1)
　　　　　　End If
　　　　　　'***

　　End With
EndLine:

End Sub

入れ替え版
　　　　　　'**
　　　　　　'B2にて、顧客名を検索
　　　　　　If .Range("B2").Value <> "" Then
　　　　　　　 i = WorksheetFunction.Match(Cells("B2").Value, .Columns(2), 0)
　　　　　　End If

　　　　　　If i = 0 Then
　　　　　　　　i = WorksheetFunction.Match(.Range("B2").Value, _
　　　　　　　　.Range("B4").Resize(LastRow), 0) '顧客名を検索
　　　　　　　　i = i + FROW - 1
　　　　　　　　Application.Goto .Cells(i, 1)
　　　　　　Else
　　　　　　　　Application.Goto .Cells(i, 1)
　　　　　　End If
　　　　　　'***

回答No.14

Wendy02

追伸です。

こちらは、Excel2003で開発していますが、たぶんバグなのだと思いますが、OnKey メソッドが、値を代入してEnter をすると、時々、動かなくなってしまいます。今しばらく、テストはしてみますが、他の手段てして、コントロールツールのテキストボックスだったら、確実だと思うのですが、それを置くことは出来ませんか？イベントの種類が豊富で、ShiftやCtrl など他のキーを加えることが可能です。

補足

Wendy02さん、こんばんは。
ご回答ありがとうございます。
いつも遅い時間まで考えてくださるようで恐縮しています。

>他の手段てして、コントロールツールのテキストボックスだったら、確実だと思うのですが、それを置くことは出来ませんか？

コントロールツールというものを使うと物事がうまく流れるのですね。
「裏の仕組みを作ってくださるWendy02さんのやりやすい方法でお願いします」と、今回もそう言って再び丸投げしたいのですがこれは引っこめます。
日々ことが大きくなっている気がして、Wendy02さんの負担になっている気がしています。
また、当初すこしの修正で解決するのかと思い、時間がありますと書いた私がいけないのですが、月末ごろには他の人にこのファイルを使ってもらうので渡さなければなりません。

間に合わなかったら改良前の（もとの）を渡すつもりでいましたが、それの確率が高くなってきたので、Wendy02さんにこれからもっと考えていただくのは申し訳ないです。（これまででも十分考えていただきました。すみません。）

確実に動くということで、(B2,C2)で検索するのをやめて、検索語をB2（C2から左にシフトしました）の顧客名ひとつにして、もう一度作っていただけないでしょうか。
勝手ばかりですみません。

※B2=AAAのときEnterでA4に移動するVBA

1　ロット　　　　顧客名
2　　　　　　「　　　　　」
3　顧客名　品名　・・・
4　　AAA
5　　AAA
6　　BBB
7　　FFF
8　　FFF
:
:
100　333　　　　LLL

よろしくお願いします。

回答No.13

Wendy02

こんばんは。

アップロードする予定でしたが、統合化は、失敗しました。

今は、何が原因で、きちんと動かないのか、良く分からなくなりました。統合する場合は、その二つは、相矛盾した設定ですから、片方を動かないようにしなければなりません。そこまでは出来たつもりでしたが、今度は、B2 エンターで、動かなくなってしまいました。

少し、無理があるかもしれませんね。横に動くマクロ、最下行に行くマクロ自体は生かしていますから。

回答No.12

Wendy02

こんばんは。

ふたつだけ回答しておきます。
>Enterだけで検索にコードを作り直していただくのは、大変手間のかかることでしょうか。

Enter だけの方が統合してよいと思います。私自身も、見えていなかった部分で、気になっていた内容ですから。次回、土曜日か日曜日までには、掲示する予定です。

>>通常、この種のものでは、検索は、コマンド・ボタンで行うのが一般的です。
もうひとつ。今のスタイルは、3年前の私では出来なかったけれども、この問題の解決では、別の方法を示していたと思います。それは、フィルタ・オプション（アドバンスド・フィルタ）です。

今の方法は、1～2年で覚えた、特殊なワザです。いつも、基本とか言っている私が、ちょっと、裏技過ぎているようで、後ろめたいのです。

補足

Wendy02さん、こんばんは。
ご回答ありがとうございます。

お待ちしています。
よろしくお願いします。

回答No.11

Wendy02

#10 の訂正
最後の行
>エラーを疲労と、飛ばなくなることがあります。
エラーを拾うと、・・・・

回答No.10

Wendy02

こんばんは。

>C2で再度FFFと入力しないとA8に移動しないのですね…。

それは、かなり問題で、気になってはいたのですが、Enter だけで検索するようにするためには、すべて、JumpMacro 側に移すことになります。

F2 + Enter で移動するようになっています。

結局、振り出しに戻ってしまいましたね。
二つのうち、ひとつというわけではありませんが、仕様とか設定は、ある程度、統一していかないといけないようです。通常、この種のものでは、検索は、コマンド・ボタンで行うのが一般的です。

また、JumpMacro を直せば、ご希望どおりになります。
シートイベント式は、とかく、エラーを疲労と、飛ばなくなることがあります。なお、コマンドボタンは、フローティング（固定していない）にするか、固定式にするかとは、選択の余地はあります。

補足

Wendy02さん、こんばんは。
ご回答ありがとうございます。

>それは、かなり問題で、気になってはいたのですが、Enter だけで検索するようにするためには、すべて、JumpMacro 側に移すことになります。

Enterだけで検索にコードを作り直していただくのは、大変手間のかかることでしょうか。
Enterだけにしても不都合が発覚するかもしれませんが、もしお願いできるのならF2なしでもF2をしたと同じ結果になる動作のコードを教えていただきたいです。
難しいことになるのでしたら、もう(B2,C2)で検索するのをやめて、顧客名だけに絞ろうと思っています。

>通常、この種のものでは、検索は、コマンド・ボタンで行うのが一般的です。

そうなのです…。
どこまでも手間を省こうと、都度、検索コマンドをひっぱりだして入力する手間を省こうとして、かえって話をややこしくして自分の手にも負えなくなって…人様が背負い込んでしまったのです。
すみません。
ここでも振り出しです。

回答No.9

Wendy02

こんばんは。Wendy02です。

>C2で編集をせずにEnterを押すと最終行のA列に移動するようですが、もとからそういう仕組みになっていますでしょうか？

確認しました。

ThisWorkbook モジュールの中の
>Private Sub JumpingMacro()

> If Not Intersect(ActiveCell, Range("$B$2")) Is Nothing Then
> Cells(65536, 1).End(xlUp).Offset(1).Select

B2 にEnter を入れたら、最後まで飛ぶように設定が残されています。
どういう設計が良かったのでしょうか？

当面とめるのでしたら、

Private Sub JumpingMacro()
Exit Sub '←と入れれば働きません。
・
・
・

補足

Wendy02さん、こんばんは。

私がよくわかっていなかったのですね。

#8の補足。C2=FFFのとき
【1】(B2,C2)=(111,FFF)=111FFFは　A7
だから当然
【2】(B2,C2)=(444,FFF)=444FFFは　A8
と思っていたのです。
FFF社がつづくときのC2は、【1】で一度FFFと入力しているため【2】では再入力が省けると思っていたのですが、C2で再度FFFと入力しないとA8に移動しないのですね…。
素人目には入っている数字は同じなのになぜ？と思えるのです。
コードは動作に反応している？のでしょうか。
B2とC2を入れ替えて(コードの部分も)もみましたが、同じ反応になるわけですよね…。

せっかくこんなに考えていただいたのに、このあとどうするか考えてご連絡します。

回答No.8

Wendy02

こんばんは。Wendy02です。

遅くなってすみません。今週は、ちょっと、ややこしい仕事があって、集中することが出来ませんでした。

どこが違うか分かりました。最初に、そういうようには作られていなかったのです。

[顧客コード]があると思ったからで、[顧客名]では検索しておりませんでした。

以下を上書きしてください。これで、様子をみてください。

------------------------------------------------------------------------

Private LastRow As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long　'検索後の行
Dim myRange As Variant　'配列データ
Dim myData As String '配列検索値
　On Error GoTo EventRegain
　'最終のEnter の起動を、C2 にする
　'データの最初を4行目とする
　Const FROW As Integer = 4
　If Target.Address <> "$C$2" And Target.Address <> "$B$2" Then Exit Sub

　If LastRow = 0 Then
　　　LastRow = Cells(Rows.Count, 1).End(xlUp).Row - FROW + 1
　End If
　If Cells(2, 2).Value = "" And Target.Value = "" Then Exit Sub
　myRange = Range("A1").Resize(LastRow).Address & " & " & Range("B1").Resize(LastRow).Address

　On Error Resume Next
　i = 0
　If Range("C2").Value = "" Then
　 '顧客コードを入れていない場合
　 i = WorksheetFunction.Match(Target.Value, Columns(1), 0)
　Else
　 myData = Range("B2").Address & "&" & Range("C2").Address
　 i = Evaluate("Match(" & myData & "," & myRange & ", 0)")
　 If i = 0 Then
　　i = WorksheetFunction.Match(Range("C2").Value, Range("B4").Resize(LastRow), 0)　'顧客コードを検索
　　i = i + FROW - 1
　 End If
　End If
　On Error GoTo 0
　　 If i > 4 Then
　　　　'スクロールを伴う場合
　　　　'Application.Goto Cells(i - 2, 1), True
　　　　Cells(i, 1).Select
　　 End If
EventRegain:
　 Application.EnableEvents = True
End Sub

補足

Wendy02さん、こんばんは。
お忙しいところ、忘れずにいてくださりありがとうございます。
#7の補足で、C2は顧客「名」だったところを顧客「コード」と入力ミスをして混乱させてしまいました。
すみません。

#8のご回答を上書きしました。
せっかく時間を割いて作っていただいた作品に、私はまた躓いてしまいました…。
下記について動作確認をお願いしたいのです。

同じ顧客がつづくときC2を新たに編集せずにEnterを押します。
このとき、最終行A列に移動してしまうので、戻るためのスクロールが難儀です…。

(例)C2=FFFがつづくとき
B2=111　C2=FFF入力後Enter　→　印刷マクロにて印刷後A2に移動
B2=444　C2=何もせずEnter　→　A100に移動で×

1　ロット　　　製品コード　　　顧客名
2　　　　　　「　　　　　」　「　　　　　」
3　製品コード　顧客名　品名　・・・
4　　111　　　　AAA
5　　222　　　　AAA
6　　111　　　　BBB
7　　111　　　　FFF
8　　444　　　　FFF
:
:
100　333　　　　LLL

入れる値に関係なく、C2で編集をせずにEnterを押すと最終行のA列に移動するようですが、もとからそういう仕組みになっていますでしょうか？
B2とC2の入力順番（配置のしかた)を入れ替えてもみたのですが、思ったようにはなりませんでした。

ご回答よろしくお願いします。