アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

「質問: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:J65536で、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で入力したものが無い確率の方が高いのです。
この場合は「あ」にセルが移動するようにしたいのですが、どのようにしたらよいのでしょうか。

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

A 回答 (17件中1~10件)

こんばんは。

Wendy02です。

約1年経ったわけで、前の私と、比較されますね。(^^;
読み違えしていたら、訂正します。

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim i As Variant
 Dim myValue As Variant
 If Target.Address = "$B$2" Then
 If Target.Value = "" Then Exit Sub
  myValue = Target.Value
  On Error Resume Next
  i = 0
  'Columns(9) は、9列目 = I 列
  i = WorksheetFunction.Match(myValue, Columns(9), 0)
  On Error GoTo 0
  If i > 0 Then
   Cells(i, 9).Select
  Else
   Range("A65536").End(xlUp).Offset(, 0).Select
  End If
 End If
End Sub

この回答への補足

Wendy02さん、こんばんは。
早速の返信ありがとうございます。
この質問がWendy02さんの目にとまったら…という思いで掲載しました。
読み違いなどではありません、待っていたのですから。

上記をコピーして貼り付けてみましたが、エラーメッセージが出ました。
c:\のなかに"ThisWorkbook.JumpingMacro"がない、のようなメッセージでした。
MicrosoftExcelObjectのsheet4(コード)にもとからあるVBAを削除してから貼り付けたり、もとのVBAをのこして貼り付けたりしましたが(ThisWorkbookも同様)、結果は同じでした。
どのようにしたらPCに気持ちが通じるのでしょう…。
貼り付けのアドバイスをよろしくお願いします。

MicrosoftExcelObjectsのsheet4(コード)には下記が入っています。

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
----------------------------------------------------------------

MicrosoftExcelObjectsのThisWorkbookには下記が入っています。
'-----------------------------------------
Private Sub Workbook_Activate()
'ブックをアクティブにした時
Call SettingMacro
End Sub
Private Sub Workbook_Open()
'ブックをオープンした時
Call SettingMacro
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'ブックをクローズした時
Call SettingOffMacro
End Sub

Private Sub Workbook_Deactivate()
'ブックを非アクティブにした時
Call SettingOffMacro
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'シートをアクティブにした時
If Sh.CodeName = "Sheet4" Then
Call SettingMacro
End If
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'シートをアクティブにした時
If Sh.CodeName = "Sheet4" Then
Call SettingOffMacro
End If
End Sub

'---------------------------
Private Sub SettingMacro()
'設定
Application.OnKey "{Enter}", "ThisWorkbook.JumpingMacro"
Application.OnKey "~", "ThisWorkbook.JumpingMacro"
End Sub
Private Sub SettingOffMacro()
'解除
Application.OnKey "{Enter}"
Application.OnKey "~"
End Sub
'---------------------------
Private Sub JumpingMacro()
If ActiveSheet.CodeName = "Sheet4" Then
If Not Intersect(ActiveCell, Range("$B$2")) Is Nothing Then
Cells(65536, 1).End(xlUp).Offset(0).Select
ElseIf Not Intersect(ActiveCell, Range("A4:H65536")) Is Nothing And _
ActiveCell.Column = 11 Then
Cells(ActiveCell.Row, 1).Select
Else
ActiveCell.Offset(, 1).Select
End If
Else
ActiveCell.Offset(1).Select
End If
End Sub

補足日時:2007/02/20 19:17
    • good
    • 0

こんばんは。

Wendy02です。

すみません、やっぱり、ちゃんと読んでいませんでした。
ただ、やっぱり、私は、1年の間には、少しスタイルが変わったようで、自分のコードなのに、少し違和感を持っています。それで、少し、不備な部分は直しました。

>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
これは、余分ですね。ただ、どうして、JumpingMacro と重なっているのか、よく分かりません。

不安が残るようなら、' をコードの頭につけて、コメント・ブロックをしてください。

デバック・ツールバーの (中が水色)「三 」のようなツールボタンがあったら、マクロのコードを選択して、これをクリックすると、すべて、コメント・ブロックがつきます。

>Private Sub Worksheet_Change(ByVal Target As Range)
これは、全部削除してしまってください。


ThisWorkbook モジュールの中にある、JumpingMacro で用が足りるはずです。

削除してしまうことには、少し不安は、残りますが、一応、作者の私がいることですから、必ず、解決には結びつけます。

'ThisWorkbook モジュール

Sub JumpingMacro()
  Dim i As Variant
  Dim myValue As Variant
  If ActiveSheet.CodeName = "Sheet4" Then
    With Sheet4
      If ActiveCell.Address = "$B$2" Then
      If ActiveCell.Value = "" Then Exit Sub
        myValue = ActiveCell.Value
        On Error Resume Next
        i = 0
        'Columns(9) は、9列目 = I 列
        i = WorksheetFunction.Match(myValue, .Columns(9), 0)
        On Error GoTo 0
        If i > 0 Then
          .Cells(i, 9).Select
        Else
          .Range("A65536").End(xlUp).Offset(, 0).Select
        End If
      End If
    End With
   End If
End Sub

なお、いつまで、私もここで続くのかは、あまりはっきりしません。昨年は、ちょうど、元のマクロを書いた後に、しばらくここを去った後でした。

この回答への補足

Wendy02さん、返信ありがとうございます!

>なお、いつまで、私もここで続くのかは、あまりはっきりしません。昨年は、ちょうど、元のマクロを書いた後に、しばらくここを去った後でした。

そうでしたか。
では今回も私はラッキーだったということになりますよね。
「必ず解決にはむすびつける」と力づよいひと言まであったのですもの。

>Private Sub Worksheet_Change(ByVal Target As Range)
>これは、全部削除してしまってください。

こちらは「Private Sub Worksheet_Change~~~」以下4行を削除の意味ととりました。
okでしょうか?

>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>これは、余分ですね。ただ、どうして、JumpingMacro と重なっているのか、よく分かりません。
>不安が残るようなら、' をコードの頭につけて、コメント・ブロックをしてください。

デバックツールボタンまたはデバックのドロップダウンを見ると、「三」らしく見えるのは「ステップイン」「ステップオーバー」「ステップアウト」なのですが、選択可はステップインしかなく、しかしこれは「’」の効果が得られません。

とりあえず、5行の行頭全部に「’」をつければいいということで、手入力をして下記の状態にしましたが…これだと削除したのと同じようなものですよね?
やはり私の受けとり方がNGでしょうか?

'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' If Target.Column = 11 Then
' Cells(ActiveCell.Row, 1).Select
' End If
'End Sub

最後はThisWorkbook のコードには改造前の「Private Sub JumpingMacro()~~~」を削除して新「Private Sub JumpingMacro()~~~」をコピーで貼り付けました。
こちらはokでしょうか?

文章を読んでいる途中で気づかれたと思いますが、結果、動かないのです。

A2からB2、B2からC2への移動が矢印キーのみになりました。
矢印キーでC2にすすんで数字を入力するとI列の該当セル(例:I30)に移動するのはいいのですが、希望はここで該当セルの行頭(例:A30)に移動なのです。

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

*****訂正があります*****
途中で$B$2だったり$C$2だったり混合していますが、そのあたりのことは貼り付けるときに変えて(sheetとThisWorkbookでは統一して)いますので、大丈夫です。

補足日時:2007/02/20 23:21
    • good
    • 0

こんばんは。

Wendy02です。

>今回も私はラッキーだったということになりますよね。
そうですね。こういう出会いは、一期一会で、自分にとって、最高のものを提供するしかありませんね。

今回は、複数の人が複数に意見で、質問者さんがまとめていくような形になりますが、本当に理解していない時があります。質問も、一個の目的ならよいのですが、複合的になると、作る側は、前にあるものを考慮していないことが多いのです。

それが、全体をややこしくしているようです。私のコードが、それ以上に、負担を掛けてしまったようです。

>Private Sub Worksheet_Change(ByVal Target As Range)
>これは、全部削除してしまってください。

すみません、撤回です。削除するのは後にしてください。今の段階では、軽率なことは出来ません。全部、通してみてから、後で、全部修正を掛けます。ワークシートモジュールにあるものは、私の作ったものではありませんね。別の動きをしていますね。これが、どう影響与えるか調べてみないと分かりませんが、初歩的なミスがあるようです。

どうも、コードがヘンな気がしましたので、前の話の流れを見直しました。ただ、全部、一度、総ざらいをしたほうがよいですね。今回は、私、1本に絞ることで、situmon10hanakoさんも、混乱することはないはずです。

いろんな複数の人のコードが、共存した状態で、いままで、よく使ってこれたなって気がします。私自身も、他人のコードを遠慮して作ったもののようです。内容的には、そんなに難しいものではないのですが、二重・三重になったことで、ややこしくなってしまいました。

なお、今回の要件は、#2 の訂正を入れて読むと

「B2で製品コードを入力してEnterを押すと、データ範囲のA列を検索して該当レコードのセルに移動」
ただし、
「A列の製品コードは1レコードにつき1コード(一品一様)ではあるが、B2で入力したものが無い場合は、A列のデータの最後尾に移動」

 B2, C2 というのは、ユーザーオプション

また、前の右にセルが動くというリクエストは生きていますね。

ということでよろしいのですか?
ご不便をおかけしますが、少し、お時間をください。

この回答への補足

Wendy02さん、こんばんは。
さきにあやまります!すみません!

二重三重のコードでも私にとっては重宝だったわけがわかりました。
時間は大丈夫ですので、しっくりくるものができるまではこちらを活用しながらゴールを待ちます。

1年前のコードのことですが、私には希望通りの動きと感じられたものが、なぜWendy02さんは余計な部分があると思ったのか…。
これは私にVBAの知識がないということだけではない気がして、仕事中にずっと考えていたのです。
そして、これは「あ」を残そうとするために話がややこしくなっているのでは?と気づきました。

私のワークシートの構成は印刷フォーム(sheet1)とデータ(sheet4)からなり、入力専用の入力フォームは存在しません。
印刷フォームにあるVLOOKUP関数が検索値「あ」を参照して印刷するのですが、この検索値を使うために検索列としてデータの中にA列をもうけていました。

今年の1月まで使っていた会社の伝票には、製品コードや顧客コードの印字がありませんでした。
この2月から社内が新システムになり、これらが印字されていたので使わない手はない!いまのデータに顧客コード列を付加したらもっと楽になるのでは?と考えたのです。
そして…
今日仕事中に「あれ?」と気づいたのです。
もう「あ」を検索値におくVLOOKUP関数を考えなくてもいい、ということは「あ」は要らないのでは?と。
Wendy02さんにしてみたら今ごろ遅すぎですね。
本当に、すみません。
製品コードは1レコードにつき1コード(一品一様)なのですから、これをキーにしてこれからは「あ」のかわりに製品コードが使えるわけですよね?
これまでの「あ」のA列を製品コード列にすればよいのですね…。

>「B2で製品コードを入力してEnterを押すと、データ範囲のA列を検索して該当レコードのセルに移動」

今回の私が「あ」の列も残したうえに、製品コード列をI列にして…などと言い出したものだから、Wendy02さんが二重三重と受けとったのでしょう!
A列を製品コードにすればスッキリ考えられるのですね~~~!

と、いうことで再確認のためもう一度やりたいことを整理します。

------------------------------------------------------------------------
【情報】データsheet
データ範囲がA4:J65536です。

A1=ロット(タイトル行)    A2=ロットのデータ
B1=製品コード(タイトル行)  B2=は製品コードデータ
C1=顧客コード(タイトル行)  C2=は顧客コードデータ

A3~J3=データ範囲A4:J65536のためのタイトル行
A3=製品コード(タイトル行)  A4=製品コードデータ 以下A5→A65536にむかって製品コードデータ
B3=顧客名(タイトル行)    B4=(株)○○○社 以下B5→B65536にむかって顧客データ
C3=製品名(タイトル行)    C4=製品□□□ 以下C5→C65536にむかって製品名データ
   :           各列にデータがつづく…
   : 

今回からC列を作りました。理由は下記の(3)です。

------------------------------------------------------------------------
【これまでできていたことで、今後も残して欲しいもの=○印】
【さらにやりたいこと=◎印】

1)○
「B2で製品コードを入力してEnterを押すと、データ範囲のA列のコードデータを検索して該当レコードのセルに
移動」

2)×これは私の勘違いにより不要です。
「A列の製品コードは1レコードにつき1コード(一品一様)ではあるが、B2で入力したものが無い場合は
A列のデータの最後尾に移動」

3-1)◎こちらは可能でしょうか?
「A列の製品コードは1レコードにつき1コード(一品一様)ではあるが、同じ製品がA社B社…と出るため、B2で製品コードを入力したあと、C2で顧客コードを入力しEnterを押すと、B2 AND C2 の条件にあったレコードの行頭(A列)に移動」

3-2)◎こちらは可能でしょうか?
「B2とC2の力関係?は製品コードB2のほうが強く、B2で入力したものが無い場合はC2で顧客コードを入力してEnterを押すと、データ範囲のC列のコードデータを検索して、該当レコードの行頭(A列)に移動」
データはいつも顧客名順にならんでいます。このあと行挿入をおこない、C2に入力された顧客名で新レコードを作ります。

>B2, C2 というのは、ユーザーオプション

○はい、そうでしたが、#3以降のご回答は(3)が可能な場合C2に統一でお願いします。

>前の右にセルが動くというリクエストは生きていますね。

○はい、こちらも残してください。
内容確認のためにグルグルしたいのです。

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

補足日時:2007/02/21 21:19
    • good
    • 0

こんばんは。

Wendy02です。

絶対に、忘れていませんから、ご安心ください。ただ、こういう仕様には、少し、気持ちを切り替えないといけないのです。すみません。

>なぜWendy02さんは余計な部分があると思ったのか…。

理由は、全体が、うまくまとまっていないからです。途中でぶつかっていないのが、不思議なくらいです。(もしかしたら、ぶつかっているかもしれませんが、200回に1回ぶつかっても、問題だからです。)

この回答への補足

Wendy02さん、こんばんは。

#3を掲示したあとで、またわかったつもりになっていたことに気づきました。
補足したあと数時間して読みなおすと、「そうじゃなかったのかも」とか「こう話せばよかった」とかそんなことばかりです。
「あ」の存在または「あ」に変わる何かがなけば、印刷のマクロには印刷範囲がアクティブ行の各セルだとわからないかも…ああ!早合点だった私…。
頭が渦を巻くだけでなく目もまわりそう。
もうもうWendy02さんにまかせますので、どうかすみませんなどとは仰らず、時間のことは気にかけないでください。

補足日時:2007/02/24 18:38
    • good
    • 0

こんばんは。

Wendy02です。

ほぼ、ご要求に対して、できあがりました。

まず、以下の二つは削除してください。生きていません。これを削除して不具合があった場合は、こちらで、対応します。また、元の質問の意味としても、違っています。書いた回答者の方には申し訳ないのですが、キャリアの差ですから、しょうがないです。

>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>If Target.Column = 9 Then
>Cells(Target.Row + 1, 1).Select
>Range("A65536").End(xlUp).Offset(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

ThisWorkbook モジュールのもの
Private Sub Workbook_Activate()など だけが生きているはずです。
もしも、不具合があるなら、それは修正いたします。

そして、シートモジュール側には、このマクロを代わりに入れてください。
'-----------------------------------------------------------

'Option Explicit
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 LastRow = 0 Then
   LastRow = Cells(Rows.Count, 1).End(xlUp).Row - FROW + 1
 End If
 If Target.Address <> "$C$2" Then Exit Sub
 If Cells(2, 2).Value = "" And Target.Value = "" Then Exit Sub
 myRange = Range("A1").Resize(LastRow).Address & " & " & Range("C1").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("C4").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さん、こんばんは。
ご回答ありがとうございます。

#3でデータsheet内の情報として載せたものが誤解を生じさせたのかもしれません。
#3の補足で、C2入力→Enter押打で「製品コード+顧客コード=該当箇所」へ移動できるから、「あ」は不要になり「あ」のあったA列を削除(左方向へシフト)して、データ範囲A4:J65536ではA列が製品コードデータにB列が顧客コードデータになっているのです。

製品と顧客のデータはそれぞれのコードを入れるセルより右に(-1)した列に設置して話を進めてしまったのです。
わかりにくい書き方でした、すみません。
(詳細は#3の補足をご参照のこと)

上記はC4を一箇所B4になおせば解決するかも?と思い、下記のようにかえてみたら移動しました。

'顧客コードを入れていない場合
  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)
                                  ここ↑をB4にしました

ですが、また問題がありますので、ご回答よろしくお願いします。

1) C2の結果しか反映されなかった
  (例)C2に○○社 B2に555が入っているとき
  製品コードのA列に555が入っている○○社のレコードがあっても、○○社が固まっている先頭行に移動してしまう。
  B2=""のときはこうあって欲しいのですが、B2=""やB2=入力ミスまたは該当なし以外のときはB2=A4:A最終行内に存在するので、B2も反映してほしいのです。
  #3の補足の順位のつけ方がわかりにくかったですね、すみません。

2) (1)が希望通りに機能しているとして、C2で編集をせずにEnterを押打しても(1)にはなりますか?
  同じ顧客の伝票がつづく場合もあります。
  そのときはC2が同じなので編集(入力)せずにEnterを押しますが、それをするとちがう顧客に移動します。(いつもいつもA4369。何の設定もしていないだけに…謎)
  右クリックするなり入力するなりの動作があるとEnterを押打後は該当する顧客の行頭に移動します。

==================キリトリ=====================
さて、上記は「あ」が必要ないときのこととして話していますが、この「あ」については上記が解決してひと段落したらまた相談させてください。

補足日時:2007/02/25 20:27
    • good
    • 0

こんばんは。



とりあえず、一箇所だけ
> i = WorksheetFunction.Match(Range("C2").Value, Range("B4").Resize(LastRow), 0)
                                  ここ↑をB4にしました

LastRow は変数ですから、それを、そこで変更することは、できません。LastRow というのは、検索する対象の列の行の最終行のことです。
何を、どこで検索するか、ということですから、C列を検索するなら、

i = WorksheetFunction.Match(Range("C2").Value, Range("C4").Resize(LastRow), 0)

となります。

私としては、文字よりも、簡単なレイアウトがあるほうが分かりやすいです。

この回答への補足

Wendy02さん、こんばんは。
ご回答ありがとうございます。
(文字数制限のため、補足内容が#6と#7にまたがっています。
お手数ですが、両方ともご覧いただきますようよろしくお願いします。)

Thisworkbookにあるコード
'-----------------------------------------
Private Sub Workbook_Activate()
'ブックをアクティブにした時
Call SettingMacro
End Sub
Private Sub Workbook_Open()
'ブックをオープンした時
Call SettingMacro
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'ブックをクローズした時
Call SettingOffMacro
End Sub
Private Sub Workbook_Deactivate()
'ブックを非アクティブにした時
Call SettingOffMacro
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'シートをアクティブにした時
If Sh.CodeName = "Sheet4" Then
Call SettingMacro
End If
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'シートをアクティブにした時
If Sh.CodeName = "Sheet4" Then
Call SettingOffMacro
End If
End Sub
'---------------------------
Private Sub SettingMacro()
'設定
Application.OnKey "{Enter}", "ThisWorkbook.JumpingMacro"
Application.OnKey "~", "ThisWorkbook.JumpingMacro"
End Sub
Private Sub SettingOffMacro()
'解除
Application.OnKey "{Enter}"
Application.OnKey "~"
End Sub
'---------------------------
Private Sub JumpingMacro()
If ActiveSheet.CodeName = "Sheet4" Then
If Not Intersect(ActiveCell, Range("$C$2")) Is Nothing Then
Cells(65536, 1).End(xlUp).Offset(0).Select
ElseIf Not Intersect(ActiveCell, Range("A4:I65536")) Is Nothing And _
ActiveCell.Column = 11 Then
Cells(ActiveCell.Row, 1).Select
Else
ActiveCell.Offset(, 1).Select
End If
Else
ActiveCell.Offset(1).Select
End If
End Sub

データsheetにあるコード
'--------------------------------
'Option Explicit
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 LastRow = 0 Then
LastRow = Cells(Rows.Count, 1).End(xlUp).Row - FROW + 1
End If
If Target.Address <> "$C$2" Then Exit Sub
If Cells(2, 2).Value = "" And Target.Value = "" Then Exit Sub
myRange = Range("A1").Resize(LastRow).Address & " & " & Range("C1").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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 11 Then
Cells(ActiveCell.Row, 1).Select
End If
End Sub

補足日時:2007/02/27 00:13
    • good
    • 0

追伸:



>1) C2の結果しか反映されなかった
>  (例)C2に○○社 B2に555が入っているとき
>  製品コードのA列に555が入っている○○社のレコードがあっても、○○社が固まっている先頭行に移動してしまう。

それは、現行では、B2 に対して、データと完全一致の検索をするようになっています。つまり、B2とC2 と、データ行が、ぴったり合えば、○○社の A列の555 のところに行くのであって、そうでなければ、○○社のみの先頭行を探すという仕組みです。


1ロット    製品コード   顧客コード
2      「      」  「     」
3        顧客名     
4  111    AAA       A1
5  222    AAA       A1
6  333    AAA       A1
7  444    BBB       B1
8  555    BBB       B1
-------------------------------------------------
B2 := 555
C2 := B1

内部の検索項目は、このようになっています。
 「555B1」

被検索データ
×「555 B1」
×「 555B1」
○「555B1」

検索ができなかった場合は、7行目にいくように作られています。

ファージーに、目でみて同じだというような、検索にはなっていませんので、検索はヒットしません。つまり、検索値に空白などブレがないことと、データにも同様に空白値など、一切のブレのないことを要求します。

ある程度は予想はしていましたが、こちらとしては、コードの行数が増えるので、そこまで、ユーザー・リクエストに合わせる方法は望んでいなかったのです。コードが読めればお分かりになっていただけるのですが、ワークシートの関数を使用して検索しております。

しかし、全体的に考え方が違うようですと、完全な変更になります。対処はできるけれども、少し、困っています。そこまでの範囲を、このような無料掲示板で請け負うのは、ちょっと、個人的にはつらいものがあります。もう、開発のレベルになってくると思います。

もう一度、その検索で、なぜヒットしなかったかのデータ自体をお調べ願えないですか?その部分では、こちらのミスはないと思います。その上で考えさせていただきたいと思います。

この回答への補足

Wendy02さん、こんばんは。
ご回答ありがとうございます。
(文字数制限のため、補足内容が#6と#7にまたがっています。
お手数ですが、両方ともご覧いただきますようよろしくお願いします。)

Wendy02さんも仰るように、無償でたくさんのことをしていただくには、限度があります。
コードが読めない説明下手な私の側にも困らせる原因があると思います。

最後に一度、Wendy02さんのレイアウトを拝借してアレンジしたものをもとに、補足#6にあるコードをコピーして動かしていただきたいのです。
と申しますのは、私がファイルをいじりすぎたせいか、不安定で自信がないのです。
これで原因がわからなければ、あきらめます。
よろしくお願いします。

1 ロット   製品コード   顧客コード
2      「     」 「     」
3 製品コード 顧客名 品名 ・・・
4  111    AAA
5  222    AAA
6  333    AAA
7  444    BBB
8  555    BBB
9  666    BBB
10  777    BBB
11  888    CCC
12  999    CCC

私のパソコンでは下記のようになってしまいます。
【その1】上書きやセル編集にて
(1-1) B2=555を入力後 C2=BBBを上書きや編集で入力
            →Enter 結果A7に移動で×
(1-2) B2=555を入力後 C2=BBBが入った状態で上書きや編集なし
            →Enter 結果A12に移動で× 
両方とも「B2 := 555 C2 := BBB →A8へ移動」になってくれない

【その2】上書きやセル編集にて
(2-1) B2=""を入力後 C2=BBBを上書きや編集で入力
            →Enter A7に移動で○
(2-2) B2=""を入力後 C2=BBBが入った状態で上書きや編集なし
            →Enter A12に移動で×
(2-2)が「B2 := "" C2 := BBB →A7へ移動」になってくれない

補足日時:2007/02/27 00:06
    • good
    • 0

こんばんは。

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の入力順番(配置のしかた)を入れ替えてもみたのですが、思ったようにはなりませんでした。

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

補足日時:2007/03/03 18:29
    • good
    • 0

こんばんは。

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を入れ替えて(コードの部分も)もみましたが、同じ反応になるわけですよね…。

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

補足日時:2007/03/06 22:22
    • good
    • 0

こんばんは。



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

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

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

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

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

この回答への補足

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

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

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

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

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

補足日時:2007/03/07 20:45
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!