• ベストアンサー

エクセル 選択候補に属性を付け、優先的に表示させたいのですが

お世話になります。エクセル2002を利用しています。 シートを複数利用し、会員が施設を利用する際の利用券を発行しようとしています。 シート「名簿」にはその3行目以降に会員情報(約400人今後増員します)があり、F列にカナ氏名・GHI列に住所・J列に氏名・K列に年齢・L列に性別が入っています。 シート「施設」にはその5行目以降に施設名(約300施設今後増加します)があり、A列にカナ名・B列に漢字名が入っています。 VBAにより、シート「会員」の該当者の「行」を右クリックすると個人情報がシート「印刷」の指定位置とシート「施設」のセルC2にコピーされ、シート「施設」にシートチェンジするようになっています。 シート「施設」から利用施設を選択し、右クリックすると施設名がシート「印刷」の指定位置にコピーされ、シート「印刷」が印刷され、シート「管理簿」に発行日(印刷日)と利用施設と利用者が上の行から順にコピーされるようになっています。 お伺いしたいのは、 1.利用者を選択したら、シート「施設」の5行目以降に表示される施設情報が、過去に利用したものを優先的に上の行に表示し、そうでないものはそれらの下の行にする。  考えたのは、施設名を選ぶと同シートのセルC2に表示されている利用者氏名をその施設名のD列から順に右へコピーしていき、その施設の属性とすることです。(参考書の.End(xlToLeft).Offset(1).Valueとかを使うのかと思いましたが、わかりません)さらに、同人物が同じ行にコピーされた場合は、コピーしないといいのです。 2.シート「施設」が開かれるときに、利用者が選択されているC3の情報から、該当者が記録されている行を上に表示させるようにしたいのです。 それが「並べ替え」や「コピー」でするべきなのかはわかりません。 文字数オーバーで詳しく説明できません。よろしくお願いいたします。

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

  • ベストアンサー
  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.11

こんばんは。 返事が遅くなり申し訳ありません。 >Set FindCell = Rows(R).Find(what:=Range("F2").Value, >この一行だけがマーカーされます。 こちらではサクサクといくんですがねぇ。(^^;;; エラーの原因を考えてみたんですが直ぐには思い浮かびませんので別な方法を使ってみましょう。 エラーの出るFindメソッドの代わりに、CountIfを使います。 シート「施設」のWorksheet_Activateイベントプロシージャーを下記のものとごっそり入れ替えてください。 変更部分は、●に囲まれた部分です。 '---------------------------------------------------------------------- '  施設シートがアクティブになった時の処理 ' Private Sub Worksheet_Activate() Dim myRange As Range Dim FindCell As Range Dim LastRow As Long Dim LastClm As Integer Dim R As Long If Range("F2").Value = "" Then Exit Sub LastRow = Range("E65536").End(xlUp).Row '●●●●● For R = 5 To LastRow Set myRange = Range(Cells(R, "F"), Cells(R, "IV").End(xlToLeft)) If WorksheetFunction.CountIf(myRange, Range("F2").Value) > 0 Then Cells(R, "B").Value = 0 Else Cells(R, "B").Value = 1 End If Next R '●●●●● If WorksheetFunction.CountIf(Range("B5:B" & LastRow), 1) = 0 Then Exit Sub LastClm = 5 For R = 5 To LastRow If LastClm < Cells(R, "IV").End(xlToLeft).Column Then LastClm = Cells(R, "IV").End(xlToLeft).Column End If Next R Set myRange = Range("A5", Cells(LastRow, LastClm)) myRange.Sort Key1:=Range("B5"), Order1:=xlAscending, _ Key2:=Range("D5"), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False End Sub '------------------------------------------------------------------------------ 前回の投稿で言い忘れましたが、以前利用した施設を施設上部に表示するためのソートキーとして、「施設」のB列(備考1)を使っています。 テストはちゃんとしてありますので安心して試してみてください。 それにしてもなぜエラーが出たのでせう。ちょと不思議です。 まさかとは思うけれどExcelのバージョンの違いがあるのかも???? 因みにこちらは、Excel2000です。 ちょくちょく覗いてみますので結果をお知らせください。 以上です。

saitama090
質問者

お礼

すごいです。 もう完璧です。 大変ありがとうございました。完全に作動します。 こちらは、Win2000 で Excel2002 を使用しています。 B列(備考1)は、テキストを入力していても0か1に書き換えられるようになっていますので、列のタイトルを「ソートキー」として使用することにしました。 ここまで、懇切丁寧に教えていただき、泣けるほど嬉しいです。 いただいたコードを勉強し、せめてこの意味を他人に説明できるようにはしたいと思います。 そのときは、このサイトでonlyrom様にどれだけ親切に教えていただいたかを話したいと思います。 本当に本当にありがとうございました。大感激です。

すると、全ての回答が全文表示されます。

その他の回答 (12)

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.2

こんばんは。 この手の質問の場合は、投稿する前に内容を何度もチェックした上で投稿すべきではないかなと、、、(^^;;; ●疑問点● >シート「名簿」にはその3行目以降に会員情報(約400人今後増員します)があり 云々 >シート「会員」の該当者の「行」を右クリックすると個人情報がシート「印刷」の指定位置とシート「施設」のセルC2にコピー シート「名簿」のレイアウトは書いてあるが、シート「会員」のレイアウトは書いてない。 また提示のコードを見ると、シート「名簿」があたかもシート「会員」であるかのような処理になっている 該当者の「行」を右クリックとあるが、提示のコードでは「セル」を右クリックしている、正しくはどちらか。 >シート「施設」から利用施設を選択し、右クリックする 提示のコードでは、シート「施設」の1,2列目(カナ、施設名)どちらを右クリックしてもいいようになっている。 また、行のチェックはされてない。 そして、シート「名簿」の右クリックでは、それらのチェックはないが、それでいいのか >2.シート「施設」が開かれるときに、利用者が選択されているC3の情報から、 質問のどこにも、セルC3のことは書いてない。 細かいことのようですが回答する上でとても重要なことですので。 以上です。

saitama090
質問者

補足

大変申し訳ございませんでした。誠におっしゃるとおりで、お恥ずかしいことをしてしまいました。 何回か修正をしていて、過って過去のものと混同してしまいました。 また、私の頭の中で、シート「名簿」のことを過ってシート「会員」と混同してしまい、述べてしまいました。 すみませんでした。 シート名は、「名簿」「施設」「印刷」「申請書」「印刷」「管理簿」を作っていて、VBAを入れているのは「名簿」「施設」「ThisWorkbook」です。 シート「名簿」は、該当行をクリックするとVBAが作動し、シート「施設」はA列とB列をクリックするとVBAが作動するようにしています。 >また、行のチェックはされてない。 >そして、シート「名簿」の右クリックでは、それらのチェックはないが、それでいいのか すみません、お尋ねいただいた下記について、私の知識が浅く、「チェック」の意味がわからないのですが、エクセルVBAは思うとおりに作動しています。 セルC3については、シート「施設」のセルC3に、現在選択している利用者がシートチェンジ後も分かるようにシート「名簿」で右クリックしたときに漢字氏名をコピーして貼り付け表示するようにしています。 本当に、素人説明で申し訳ありませんでした。よろしくお願いします。 現在使用しているエクセルブックから、コードをコピーしました。 【シート「名簿」のコード】 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) With Sheets("印刷") .Range("E15:E17").Value = _ Application.Transpose(Cells(Target.Row, 7).Resize(, 3).Value) .Range("AA16").Value = _ Cells(Target.Row, 10).Value .Range("AQ16").Value = _ Cells(Target.Row, 11).Value .Range("AX16").Value = _ Cells(Target.Row, 12).Value End With With Sheets("施設") .Range("C2").Value = _ Cells(Target.Row, 10).Value End With Cancel = True Sheets("施設").Select End Sub 【シート「施設」のコード】 'カナ施設名の列を右クリックすると、施設が記載される。 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Target.Count > 1 Then Exit Sub If Target.Column > 2 Then Exit Sub Cancel = True Worksheets("印刷").Range("C10").Value = Me.Cells(Target.Row, 2).Value '管理簿に本日の日付を入力 ThisWorkbook.Sheets("管理簿").Range("A65536").End(xlUp).Offset(1).Value = Date '管理簿にあて先(施設)を入力 ThisWorkbook.Sheets("管理簿").Range("B65536").End(xlUp).Offset(1).Value = ThisWorkbook.Sheets("印刷").Range("C10").Value '管理簿にあて先(利用者)を入力 ThisWorkbook.Sheets("管理簿").Range("C65536").End(xlUp).Offset(1).Value = ThisWorkbook.Sheets("印刷").Range("AA16").Value '管理簿に:部数を入力(1と入力) ThisWorkbook.Sheets("管理簿").Range("D65536").End(xlUp).Offset(1).Value = "1" '管理簿に:印名を入力(窓口印と入力) ThisWorkbook.Sheets("管理簿").Range("E65536").End(xlUp).Offset(1).Value = "窓口印" '管理簿に:保管者を入力(窓口担当と入力) ThisWorkbook.Sheets("管理簿").Range("F65536").End(xlUp).Offset(1).Value = "窓口担当" '連絡書を印刷 Worksheets("印刷").PrintOut End Sub

すると、全ての回答が全文表示されます。
回答No.1

自分なら・・・ 1)施設に利用者を追加するのではなく、利用者に過去の施設を追加するようにする。 2)過去の施設タブを作っておく。 3)利用者が選択されたら、過去の施設タブに移動して一覧を転記する。あるいは、利用者名を入力すれば一覧が表示されるように関数を用意しておき、利用者名を転記する。ここでも施設タブのように右クリックでコピーできるようにしておく。 4)過去の施設に該当がなければ施設タブに移動して探す。ここで探したときには、利用者に過去の施設を追加する。 5)作業が終了したら、過去の施設タブに転記した内容を消去する。 コードがないので何とも言えないのですが、 Range("利用者名のセル").End(xlToRight).Offset(1).Value = "施設名" で、右端に入力されると思います。

saitama090
質問者

お礼

なるほど。組み立て方として、その方がスッキリするようですね。勉強になります。 私の今の段階でのコードを貼り付けます。 回答ありがとうございました。 【シート「名簿」のコード】 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) With Sheets("印刷") .Range("E15:E17").Value = _ Application.Transpose(Cells(Target.Row, 7).Resize(, 3).Value) .Range("AA16").Value = _ Cells(Target.Row, 10).Value .Range("AQ16").Value = _ Cells(Target.Row, 11).Value .Range("AX16").Value = _ Cells(Target.Row, 12).Value End With With Sheets("施設") .Range("C2").Value = _ Cells(Target.Row, 10).Value End With Cancel = True Sheets("施設").Select End Sub 【シート「施設」のコード】 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Target.Count > 1 Then Exit Sub If Target.Column > 2 Then Exit Sub Cancel = True Worksheets("印刷").Range("C10").Value = Me.Cells(Target.Row, 2).Value ThisWorkbook.Sheets("管理簿").Range("A65536").End(xlUp).Offset(1).Value = Date ThisWorkbook.Sheets("管理簿").Range("B65536").End(xlUp).Offset(1).Value = ThisWorkbook.Sheets("印刷").Range("C10").Value ThisWorkbook.Sheets("管理簿").Range("C65536").End(xlUp).Offset(1).Value = ThisWorkbook.Sheets("印刷").Range("AA16").Value ThisWorkbook.Sheets("管理簿").Range("D65536").End(xlUp).Offset(1).Value = "1" ThisWorkbook.Sheets("管理簿").Range("E65536").End(xlUp).Offset(1).Value = "窓口印" ThisWorkbook.Sheets("管理簿").Range("F65536").End(xlUp).Offset(1).Value = "窓口担当" Worksheets("印刷").PrintOut End Sub

すると、全ての回答が全文表示されます。

関連するQ&A