エクセルVBA リストボックスで選択した値の、該当行を選択して塗りつぶしたいです。

Question

超超初心者です。わかりやすく教えてください。個人の成績表を作成したいのですが、（実際の工程は１０で人数は４０人程度）
質問①
図のようなリストボックスで、クリックして選択したら、元のシートの該当データの行を選択して、塗りつぶしたいのですが、うまくできません。教えてください。（塗りつぶし後全工程を降順に並び替えて各工程の順位を表すため）

質問②
①の後、グラフ作成のため、選択した行のコピーを表の下方の余白にコピーしたいのですが、どのように書けばよいでしょうか。
よろしくお願いいたします。

Option Explicit
 　Private lastrow As Long
 　Private index As Integer
Sub userform_initialize()
 　Dim i As Long
   　For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
     　名前リスト.AddItem Cells(i, 1)
   　Next i
End Sub

Sub 名前リスト_Click()
 　Dim i As Long
 　Dim no As Long
     名前リスト.ListIndex = no
      index = no + 3
       Rows(index).End(xlToLeft).Select
 
   　With Selection.Interior
      .Color = 15773696
     End With
End Sub

Sub btnsort_click()
  Dim j As Long
   For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
    Columns(j).Sort key1:=Cells(1, j), order1:=xlDescending, Header:=xlYes
   Next j
End Sub

tatsu99 · Accepted Answer

>ご指定のサイトを表示しますと、ところどころ単語が和訳されたようになって
文字化けでしょうか。
ブラウザの文字コードをutf-8にしてみて下さい。

tatsu99 · Answer

No7です。
No7で提示したサイトの内容に誤りがありました。（No7のサイトのマクロは使用しないでください）
下記のサイトが正しいので、こちらを使用してください。
https://ideone.com/zm6BiS

又、チューニングパラメータとして、
Const Y_unit As Long = 5        'グラフ縦軸目盛単位
を追加しました。
1目盛の単位です。現在は5人にしてありますが、変える場合は、これを変えてください。

tatsu99 · Answer

下記URLにマクロをアップしました。ここから取得してください。
https://ideone.com/5reAZ1

前提ですが、
工程数＝１９
1行目　期の見出し
２行目　工程の見出し
３行目以降　各担当者のデータ

1期分で２０列（名前＋工程）を使用し、１列空欄を開ける。
４期分までサポート（4期の工程１９は、CE列）
とします。
チューニングパラメータとしては、
Const baseSheetName As String = "成績表"
Const workSheetName As String = "作業"
Const No_koutei As Long = 19    '工程数
Const X_ratio As Double = 1#      'グラフ横軸倍率
Const Y_ratio As Double = 1#    'グラフ縦軸倍率
がありますが、あなたの環境にあわせて適切に設定して下さい。

Const baseSheetName As String = "成績表"
は元データのシート名です。元データのシート名が異なるならこれを変えてください。

Const workSheetName As String = "作業"
は作業データのシート名です。（予めこの名前のシートを作成しておいてください。中身は空で結構です）

Const No_koutei As Long = 19    '工程数
は、工程数です。今後、工程数に増減があるなら、これを変えてください。

Const X_ratio As Double = 1#      'グラフ横軸倍率
は、グラフの横軸の倍率です。
グラフを小さくしたいなら、0.8（0.8倍になります）、大きくしたいなら1.2（1.2倍になります）等の好みの値を設定して下さい。

Const Y_ratio As Double = 1#    'グラフ縦軸倍率
はグラフ縦軸倍率です。使用方法は、グラフの横軸倍率に準拠します。

tatsu99 · Answer

画像が小さかったので、Ｂ案のグラフとＡ列～Ｋ列、及び並べ替え結果を画像にしました。

tatsu99 · Answer

Ｂ案です。

tatsu99 · Answer

Ａ案です。

tatsu99 · Answer

添付資料が１つだけしか投稿できませんので、こちらに投稿します。
添付資料2です。

tatsu99 · Answer

No2です。補足拝見しました。
こちらで、4半期毎の管理方法の検討、及びグラフの作成の検証等の作業があり、返信が遅れました。
一応、どのように管理するかのめどが立ちましたので、以下に回答します。
これから述べることの前提で良ければ、マクロの提供は可能です。

①＞並び替えは戻せないので、先に元シートをシート追加ボタンで人数分コピーし、一人ずつ成績表を印刷して渡す事を想定しています。
これについては、元のマスターのシートと作業用のシートを作成し、
選択された人が変わる度に、元シートから作業用のシートに全員の成績をコピーし直しては、いかがでしょうか。
そして、作業用のシートについて、誰かを選択し、並べ替え、グラフ作成等を行います。
それが、終われば、他の人を選択しますが、その時、前の人の状態はクリアされ、初期状態に戻ります。
何故、最初に人数分シートをコピーするのが良くないかというと、もし、間違って他の人を選択し、並べ替えを行うと、元に戻せない為、
元シートのコピーからやり直しする必要がある為です。

②選択された氏名を、成績の下の方に格納すると、並び替えの時、そのデータも含まれるので、よろしくない旨の指摘をしましたが
ソート時に範囲を指定して行えばこの現象は避けられます。（btnsort_Clickの改造が必要になります）
従って、成績表の下に１行開けて、選択された人のコピーを行うようにできます。
また、その下の行に、その成績の順位を表示するようにできます。（マクロで行うのでRANK.EQ関数を予めシートに埋め込む必要はなし）

③４半期毎の成績を表示したいということですが
以下のようになります。
最初の四半期を１期、
次の四半期を２期、
次の次の四半期を３期、
最後の四半期を４期　と呼びます。
表の左側から順に１期、２期、３期、４期を表示する。
表は１列目に期の見出し、
２列目に期を工程の見出し、
３列目以降にデータ行となります。
各期の間は1列空白を入れます。
工程は１０工程とします。
従って、
１期＝Ａ～Ｋ列
２期＝Ｍ～Ｗ列
３期＝Ｙ～ＡＩ列
４期＝ＡＫ～ＡＵ列　となります。

詳細は、添付図１、添付図２を参照

④＞グラフですが、各工程は分母が異なるため、単純に数値のみでグラフにしても意味がないので、各列ごとのRANK EQ関数？等を使って順位の折れ線グラフを作成し・・・
「各工程は分母が異なるため」とは、どういう意味でしょうか。成績（得点）は単純に１００点満点で、０～１００の数値が設定されると理解していましたが
そうではないのでしょうか。各工程ごとに最大の得点が異なるのでしょうか。その場合、最低と最高の得点はどうなりますか？
もし、得点もグラフにするなら、最低と最高の得点を知っておく必要があります。（各工程ごとに目盛は用意できないので全工程共通になります）

⑤グラフは、Ａ案（得点と順位の両方表示）でしょうか、それともＢ案（順位のみ表示）
（添付の画像Ａ案、Ｂ案を参照。３つの4半期について表示。最大は４つの４半期について表示することになる）

⑥シート名ですが、
元シートを「成績表」
作業シートを「作業」とします。
他に希望があれば、提示してください。

以上、ご確認及び補足をお願いします。

tatsu99 · Answer

質問①について、こちらで修正しました。（添付図の上が選択した名前を選択した状態、下がソートした状態）
質問②の意味がよくわかりません。
例えば、鈴木太郎を選択したら、A2～D2を10行目（A10～D10）へコピーしたいということでしょうか。
もし、そうなら、そのコピーしたデータも、ソートした時、ソート対象のデータに含まれてしまいます。
従って、添付の場合なら、2行目以降、かつ、E列より右側にコピーしないとまずいかと。
また、ソートを行うと、B列以降の各列が降順になりますが、この時点で、データが壊れます。
他の人を選択し、ソートする為には、一旦、ソート前の状態に戻す必要がありますが、
このままでは、戻せません。この点、どのように対処されるつもりでしょうか？
-----------------------------------------------
Option Explicit

Private lastrow As Long
Private index As Integer
Private maxcol As Integer

Private Sub UserForm_Initialize()
    Dim i As Long
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).row
        名前リスト.AddItem Cells(i, 1)
    Next i
    lastrow = 0
    maxcol = Cells(1, Columns.Count).End(xlToLeft).Column
End Sub

Private Sub 名前リスト_Click()
    Dim i As Long
    Dim no As Long
    no = 名前リスト.ListIndex
    index = no + 2
    If lastrow <> 0 Then
        Range(Cells(lastrow, 1), Cells(lastrow, maxcol)).Interior.Color = xlNone
    End If
    Range(Cells(index, 1), Cells(index, maxcol)).Interior.Color = 15773696
    lastrow = index
End Sub

Private Sub btnsort_Click()
    Dim j As Long
    For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
        Columns(j).Sort key1:=Cells(1, j), order1:=xlDescending, Header:=xlYes
    Next j
End Sub
-------------------------------------------------------

エクセルVBA リストボックスで選択した値の、該当行を選択して塗りつぶしたいです。

>ご指定のサイトを表示しますと、ところどころ単語が和訳されたようになって

No7です。

下記URLにマクロをアップしました。

画像が小さかったので、Ｂ案のグラフとＡ列～Ｋ列、及び並べ替え結果を画像にしました。

Ｂ案です。

Ａ案です。

添付資料が１つだけしか投稿できませんので、こちらに投稿します。

No2です。

質問①について、こちらで修正しました。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング