| |
▼toki さん、Jakaさん
こんばんは。
>
>
>Private Sub 職務別印刷上期実行ボタン_Click()
>
> Dim erCh As Variant
> Dim comP1 As Variant
> Dim gyo As Variant
> Dim ten As Range
> Dim c As Range
> Dim myten1 As Variant, myten2 As Variant
> Dim mycomiT As Variant
>
>
> Application.ScreenUpdating = False
>
> 'ユーザーフォームの表示テキストから職務名を変数に代入
> sentakuI = Replace(sentakuP, "Level", "") ’←sentakuPというのは「職務＋Level」で構成された変数のため、「職務」だけを抽出しています。
>
>
> '社員登録がされている職務かどうかのチェック
> With Worksheets("4月")
> erCh = Application.Match(sentakuI, .Range("A:A"), 0)
> End With
sentakuPは、TextBox1.Value ですか？
それなら、ここですでにsentakuIによる検索があっていることになります。
つまり、職務を下でオートフィルターで抽出しているので、登録しているかどうかの
二重チェックの意味ですか？
>
> If Me.職務別印刷TextBox1.Value = "" Then
> MsgBox "いずれかの職務を選択してください。", vbExclamation, "職務選択": Exit Sub
したがって、これは、検索前に行わないといけないと思います。ここが空だと
sentakuIによる検索ができないと思います。
> ElseIf IsError(erCh) Then
> MsgBox "この職務の社員登録はありません。", vbExclamation, "登録なし": Exit Sub
>
> Else
>
> '点数集計
> '****************************************
> '職務によるオートフィルター絞込み
> '****************************************
> With Worksheets("4月")
> '4月A列に職務によるオートフィルターをかける
> .Range("A6", "A65536").AutoFilter field:=1, Criteria1:=sentakuI
> '抽出されたC列をmyRに格納
> Set myR = .Range("C7", "C65536").SpecialCells(xlCellTypeVisible)
>
> 'C列を上から順に（C＝社員番号）
> For Each c In myR
>
>
> '****************************************
> '4月点数コピーペースト
> '****************************************
> '4月
> With Worksheets("4月")
> gyo = Application.Match(c, .Range("C:C"), 0)
↑
c.value？？
でも、Jakaさんが言っているように、
Set myR = .Range("C7", "C65536").SpecialCells(xlCellTypeVisible)
この段階で、sentakuIによる抽出は、終わっているので、
myRを順番に転記していけばよいのでは・・・・
For Each C in myR
myten1 = C.Offset(0, 0).Resize(1, 5).Value 'はじめの５つ
myten2 = C.Offset(0, 5).Resize(1, 5).Value '次の５つ
mycomiT = C.Offset(0, -1).Value 'コミット取り出し
ただ、C.Valueというのが特定の社員番号なら話は別ですが・・・
このままでは、
For Each C in myRのC と
gyo = Application.Match(c, .Range("C:C"), 0)の
C.Valueは同じになります。
それなら、gyo = Application.Match(c, .Range("C:C"), 0)は、
意味ないと思います。
> Set ten = .Cells(gyo, 5) '←←←ここでエラー反転しています。型が違うとのこと。
> '点数のコピー
> myten1 = ten.Offset(0, 0).Resize(1, 5).Value 'はじめの５つ
> myten2 = ten.Offset(0, 5).Resize(1, 5).Value '次の５つ
> mycomiT = ten.Offset(0, -1).Value 'コミット取り出し
> '人事評価シートへ
> With Worksheets("人事評価シート")
> .Cells(9, 2).Value = mycomiT 'コミット貼り付け
> .Cells(13, 2).Resize(5, 1).Value = Application.Transpose(myten1)
> .Cells(19, 2).Resize(5, 1).Value = Application.Transpose(myten2)
> End With
>
> End With
>
>
> 'オートフィルターの解除
> Worksheets("4月").Range("A6", "A65536").AutoFilter
> 'プリントアウト
> Worksheets("人事評価シート").PrintOut
>
> Next
>
>
> End With
>
>
> End If
>
> Application.ScreenUpdating = True
>End Sub
|
|
ponpon
- 05/10/5(水) 18:34 -
