Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


33928 / 76734 ←次へ | 前へ→

【48021】確当値を色別で転記
質問  hiro  - 07/3/30(金) 20:30 -

引用なし
パスワード
   いつも教えて頂きありがとうございます

休日一覧表1ヶ月分から日にちを指定して一日分の出勤状況を部署ごとに表示したいのですが?
シート1のA4から部署コード1から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

k1に16を入力すると上のように転記させやいのですが
現状"休"の人を表示するところまでしかわからず悩んでおります
どなたかよろしくお願いいたします(部署別にもなっていません)
シート1の部署コードは順番に並んでいません 社員No.は1から並んでいます
各部署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

3 hits

【48021】確当値を色別で転記 hiro 07/3/30(金) 20:30 質問
【48028】Re:確当値を色別で転記 りん 07/3/31(土) 9:05 回答
【48034】Re:確当値を色別で転記 hiro 07/3/31(土) 23:06 お礼
【48040】Re:確当値を色別で転記 りん 07/4/1(日) 10:20 回答
【48054】Re:確当値を色別で転記 hiro 07/4/1(日) 22:11 お礼

33928 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free