| |
▼ponpon さん：
ponponさんこんにちは。
いろいろと試してみました！
まず、仕様についてですが、個人ごとに点数集計シートを「新規ワークシート」としては作成しないつもりです。
私の説明の仕方がまずかったのですが、個人ごとの集計シートは「印刷」のみ行います。
また、職務→社員番号の整理（Sort）については、社員登録の際に、ユーザーフォームの登録ボタンを実行すると、登録
時に整理用のマクロが起動するようにしました。
このマクロで社員番号Keyを追加し連続Sortしています。
問題は4月〜9月までのデータの取り出しと、点数集計表への貼り付け印刷なのですが、ponponさんのマクロですと
CurrentRegionが使用されています。
私も詳しくないのですが、CurrentRegionは保護されたワークシート上ではErrorを出すと読んだことがあります。
今回、集計以外の見出しの部分などを保護する予定なので使用を避けようかと思いますがいかがでしょう？
> '***************************************
> 'シート４月から９月までデータの取り出し
> '***************************************
> myARy = Array("４月", "５月", "６月", "７月", "８月", "９月") '全角 シート名も全角で
> For i = 0 To UBound(myARy)
> '4月から順に9月のシートまで
> With Worksheets(myARy(i))
●登録ボタンでＡ列・Ｃ列は整理済のため、この部分は不要でしょうか？
> '範囲をセットし、A列・C列でソート
> Set myR = .Range("A1").CurrentRegion
> myR.Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range( _
> "C2"), Order2:=xlAscending, Header:=xlGuess
●AA列というのは一時的に仮置きで使用しているということでしょうか？目的は職務の種類（例えばJ,S,M）の抽出でよろしいでしょうか？
> 'A列を重複なしでAA列に書き出す。
> myR.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("AA1"), Unique:=True
> 'AA列の2行目から終わりまでをmyValに格納
> myVal = .Range("AA2", .Range("AA65536").End(xlUp)).Value
だとすると、ユーザーフォームでの職務選択時に職務を取得できるのでそれを利用しようと思います。
●行列の入れ替えですが、行を列にするときに、仕様上見出しが列の真中にも入るため変数を使用せざるを得ないような気がします。
ponponさんのを改造して下記のようなマクロにしたら、うまく動きました。
ちなみにsentakuPにはすでにワークシート名が格納されています。
※マクロ中の変数はpublic宣言済みのものもあります。
'点数集計
Dim sentakuP As Variant
Dim sentakuV As Variant
Dim sentakuI As Variant
Dim myRow4 As Variant
Dim myRow5 As Variant
Dim myRowten As Variant
Dim myR As Range
Dim c As Range
sentakuI = Replace(sentakuP, "Level", "")
With Worksheets("4月")
'4月A列に職務によるオートフィルターをかける
.Range("A6", .Range("A65536").End(xlUp)).AutoFilter Field:=1, Criteria1:=sentakuI
'抽出されたC列をmyRに格納
Set myR = .Range("C7", .Range("C65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
'C列を上から順に
For Each c In myR
'社員番号、社員名書き出し
With Worksheets("点数集計シート")
.Range("D3") = c.Offset(0, 0).Value
.Range("D5") = c.Offset(0, -1).Value
End With
'点数をコピー4月分
With Worksheets("4月")
myRow4 = Application.Match(c, .Range("C:C"), 0)
comp1_4 = .Cells(myRow4, "C").Offset(0, 2).Value
comp2_4 = .Cells(myRow4, "C").Offset(0, 3).Value
comp3_4 = .Cells(myRow4, "C").Offset(0, 4).Value
comp4_4 = .Cells(myRow4, "C").Offset(0, 5).Value
comp5_4 = .Cells(myRow4, "C").Offset(0, 6).Value
comp6_4 = .Cells(myRow4, "C").Offset(0, 7).Value
comp7_4 = .Cells(myRow4, "C").Offset(0, 8).Value
comp8_4 = .Cells(myRow4, "C").Offset(0, 9).Value
comp9_4 = .Cells(myRow4, "C").Offset(0, 10).Value
comp10_4 = .Cells(myRow4, "C").Offset(0, 11).Value
End With
With Worksheets("点数集計シート")
.Range("B13") = comp1_4
.Range("B14") = comp2_4
.Range("B15") = comp3_4
.Range("B16") = comp4_4
.Range("B17") = comp5_4
.Range("B19") = comp6_4
.Range("B20") = comp7_4
.Range("B21") = comp8_4
.Range("B22") = comp9_4
.Range("B23") = comp10_4
End With
'点数をコピー5月分
With Worksheets("5月")
myRow5 = Application.Match(c, .Range("C:C"), 0)
comp1_5 = .Cells(myRow5, "C").Offset(0, 2).Value
comp2_5 = .Cells(myRow5, "C").Offset(0, 3).Value
comp3_5 = .Cells(myRow5, "C").Offset(0, 4).Value
comp4_5 = .Cells(myRow5, "C").Offset(0, 5).Value
comp5_5 = .Cells(myRow5, "C").Offset(0, 6).Value
comp6_5 = .Cells(myRow5, "C").Offset(0, 7).Value
comp7_5 = .Cells(myRow5, "C").Offset(0, 8).Value
comp8_5 = .Cells(myRow5, "C").Offset(0, 9).Value
comp9_5 = .Cells(myRow5, "C").Offset(0, 10).Value
comp10_5 = .Cells(myRow5, "C").Offset(0, 11).Value
End With
With Worksheets("点数集計シート")
.Range("C13") = comp1_5
.Range("C14") = comp2_5
.Range("C15") = comp3_5
.Range("C16") = comp4_5
.Range("C17") = comp5_5
.Range("C19") = comp6_5
.Range("C20") = comp7_5
.Range("C21") = comp8_5
.Range("C22") = comp9_5
.Range("C23") = comp10_5
End With
'プリントアウト
Worksheets("点数集計シート").PrintOut
Next
'オートフィルターの解除
.Range("A6", .Range("A65536").End(xlUp)).AutoFilter
End With
●結局点数集計シートの各月の入力セル（列）が異なるため、4月シートを基礎として抽出した印刷対象者について、全月の貼り付け作業をを実行していくしかないわけですよね？
つまり対象者ごとにワークシートを作成するわけではないので、各月ごとの繰り返し処理ではなく、ひとりひとり印刷実行までの処理を終わらしていかないといけないので・・・
●それと平均値の件ですが、ワークシート側に数式を入れてありますのでVBAでの操作は基礎データの入力まで、としました。
以上、ponponさんのソースが非常に参考になりました。
改めて御礼申し上げます。
もう少しいろいろと試してみますので、またよろしくお願いします！
|
|
toki
- 05/9/23(金) 16:56 -
