| |
いつも教えて頂きありがとうございます
休日一覧表1ヶ月分から日にちを指定して一日分の出勤状況を部署ごとに表示したいのですが？
シート1のA4から部署コード１から10 B4から社員コード1から100 C4から氏名
D2からAH2まで日にち16から31が入力してあります
A B C D E F G
1
2 16 17 18
3 部署 社員 氏名 月 火 水
4 1 1 a 休 外
5 1 2 b 外 休
6 2 3 c 外 休
7 4 4 d
8 3 5 e 休
9 4 6 f 休 休
10
シート2のK1に日にちを入力して
その日の勤怠状況を部署別にブランクの人は黒
休の人は赤
外の人は青で表示したいのです
シート2
A B C D
1 部署 氏名 a eを赤
2 1 a b b を青
3 2 c cdfを黒で表示
4 3 e
5 4 d f
ｋ1に16を入力すると上のように転記させやいのですが
現状"休"の人を表示するところまでしかわからず悩んでおります
どなたかよろしくお願いいたします（部署別にもなっていません）
シート1の部署コードは順番に並んでいません 社員No.は1から並んでいます
各部署１人から最高10人までです
Public Sub Test()
Dim wsIn As Worksheet
Dim wsOut As Worksheet
Dim rngFind As Range
Dim sFind As String
Dim celFound As Range
Dim cFound As Long
Dim ixDate As Long
Dim firstAddress As String
Set wsIn = ThisWorkbook.Worksheets("Sheet1")
Set wsOut = ThisWorkbook.Worksheets("Sheet2")
ixDate = wsOut.Range("K1").Value
With wsIn
If ixDate >= 16 Then
Set rngFind = .Range(.Cells(4, 3 + ixDate - 15), .Cells(30, 3 + ixDate - 15))
Else
Set rngFind = .Range(.Cells(4, 3 + ixDate + 16), .Cells(30, 3 + ixDate + 16))
End If
End With
sFind = "H"
Set celFound = rngFind.Find(sFind, _
, _
xlValues, _
xlWhole, _
xlByRows, _
xlNext, _
True, _
True)
If Not (celFound Is Nothing) Then
firstAddress = celFound.Address
Do
cFound = cFound + 1
With wsOut.Range("B2").Offset(((cFound - 1) \ 10), ((cFound - 1) Mod 10))
.Value = wsIn.Cells(celFound.Row, "C").Value
.Font.ColorIndex = 3
End With
Set celFound = rngFind.FindNext(celFound)
If celFound Is Nothing Then Exit Do
If celFound.Address = firstAddress Then Exit Do
Loop
End If
End Sub
|
|
hiro
- 07/3/30(金) 20:30 -
