| |
▼Jaka さん：
ご回答ありがとうございます。
Jakaさんのソースを貼り付けて実行してみましたが、無限ループに入ってしまいます。
ちなみに4月シートの状況ですが、J職社員番号8番の人間が1件あります。
そこでJ職を指定して、印刷をかけました。本来だと、J職でオートフィルターがかけられてC列の社員番号から8番だけを拾って
印刷実行し、終了するはずなのですが、無限印刷に入ります。
※なお下記変数のうちsentakuI には、J職が格納され、erChには社員番号の”8番”が格納されていることをウォッチ式で確認してます。
従って点数集計以降のループの問題だと思うのですがいかがでしょうか？
Private Sub 職務別印刷上期実行ボタン_Click()
Dim erCh As Variant
Dim mycomPT As Variant
Dim hvten As Variant
Dim myten1 As Variant, myten2 As Variant
Dim mycomiT As Variant
Dim myR As Range
Application.ScreenUpdating = False
sentakuI = Replace(sentakuP, "Level", "")
'社員登録がされている職務かどうかのチェック
With Worksheets("4月")
erCh = Application.Match(sentakuI, .Range("A:A"), 0)
End With
If 職務別印刷TextBox1.Value = "" Then
MsgBox "いずれかの職務を選択してください。", vbExclamation, "職務選択": Exit Sub
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
myten1 = c.Offset(0, 0).Resize(1, 5).Value 'はじめの５つ
myten2 = c.Offset(0, 5).Resize(1, 5).Value '次の５つ
mycomiT = c.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
'オートフィルターの解除
Worksheets("4月").AutoFilterMode = False
'プリントアウト
Worksheets("人事評価シート").PrintOut
DoEvents
Next
End With
End If
Application.ScreenUpdating = True
End Sub
|
|
toki
- 05/10/5(水) 22:08 -
