VBAの従業員の固定休を求めるプログラムを教えていただきたいご質問になります。
添付した画像を例とします。
シートの名前を勤務管理表とし、A3セルから下にAさん、Bさん、Cさんと入力されています。
ここでは3名とします。
例えば別シートのA1セルにAさん。A2セルに休みの「金」、A3セルに「月」の文字を入力。
それを勤務管理表のAさんのB3セルから左のセル欄に「休」を出力し、またBさん、Cさんも同じ様に入力したい内容になります。

勤務管理表で従業員を50名程作成しなくてはならず作業効率向上の為、一括で入力したいと思いましたので、どなたか詳しい方のご回答をお待ちしております。
よろしくお願い致します。

「VBAシフト表における従業員の固定休のプ」の質問画像

質問者からの補足コメント

  • 要塞まほろぼさん回答ありがとうございます。
    いえ火曜日は定休日ではありません。
    ここでは例として従業員を3名とし、その際に火曜日が全員出勤になってしまったものになります。
    Aさんの固定休は金、月。
    Bさんは土、水。
    Cさんは日、木。
    仮にDさんがおり、固定休が火、金。
    となる可能性もあるのでその場合はどの様にプログラムを組めばよろしいのか教えていただきたいです。

    よろしくお願い致します。

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/05/12 02:36

A 回答 (6件)

以下のマクロを標準モジュールへ登録してください。


休みの指定は、添付図のようにB~H迄の列に指定します。
1,2行はマクロ実行前に既に作成されていることが前提、A列の3行以降の従業員名も実行前に作成されていることが前提です。
-----------------------------------------------
Option Explicit
Public Sub 休日割当()
Dim sh1, sh2 As Worksheet
Dim dicT As Object
Dim row, col, maxrow As Long
Dim key, wk As String
Dim i As Long
Set dicT = CreateObject("Scripting.Dictionary")
Set sh1 = Worksheets("休日表")
Set sh2 = Worksheets("勤務管理表")
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).row 'Sheet1 A列最大行
'従業員の休みの曜日を取得
For row = 1 To maxrow
key = sh1.Cells(row, "A").Value
wk = ""
'B列からH列まで休みの曜日を取得
For col = 2 To 8
If sh1.Cells(row, col).Value = "" Then Exit For
wk = wk + sh1.Cells(row, col).Value
Next
dicT(key) = wk
Next
maxrow = sh2.Cells(Rows.Count, "A").End(xlUp).row 'Sheet2 A列最大行
'休みの設定領域をクリア
sh2.Range("B3:AF" & maxrow).Clear
For row = 3 To maxrow
key = sh2.Cells(row, "A").Value
If dicT.exists(key) = False Then
MsgBox (key & "は休日表に未登録です。処理を打ち切ります。")
Exit Sub
End If
wk = dicT(key)
For i = 1 To 31
col = 2 + i
If sh2.Cells(2, col).Value = "" Then Exit For
If InStr(wk, sh2.Cells(2, col).Value) > 0 Then
sh2.Cells(row, col).Value = "休"
sh2.Cells(row, col).Interior.ThemeColor = xlThemeColorDark1
sh2.Cells(row, col).Interior.TintAndShade = -0.249977111117893
End If
Next
Next
MsgBox ("完了")
End Sub
「VBAシフト表における従業員の固定休のプ」の回答画像6
    • good
    • 0
この回答へのお礼

tatsu99さんありがとうございます!
正に私が求めていたプログラムです!
色々触って勉強させていただきます。

この度はありがとうございました。
またこちらで質問をさせて頂くと思いますが、ご機会がございましたらよろしくお願い致します。

お礼日時:2017/05/13 05:20

No4です。

別シートの記入方法ですが、
人の並びが同じになるので、図1よりは図2のほうが良いかと思いますが、いかがでしょうか。
図1があなたが提示された方法です。
「VBAシフト表における従業員の固定休のプ」の回答画像5
    • good
    • 0

マクロで作成するとして、いくつか不明点があります。


1)B1は必ず12日から始まるのですか。
2)1行目(日付)と2行目(曜日)は、既に作成済みという前提で良いのですか。
それとも、マクロで1行目も2行目も作るのですか。
3)これは、横に一か月分ですか、1年分ですか。
4)1人の休みの曜日は、2日分で固定ですか。
Aさんが、月
Bさんが、火、金
Cさんが、水、木、土
のようなケースはあるのですか。
5)50人分つくる場合は、Cさんの次の行から、Dさん、Eさんと続くと考えて良いですか。
    • good
    • 0
この回答へのお礼

tatsu99さん回答ありがとうございます。
ご質問に回答致します。
1)B1は前回のtatsu99さんに教えていただいたVBAのコードを参考に「s_date = sh1.Cells(4, "A1").Value」 (※ A1に2017/5/10と入力します)
2)1行目は「sh1.Cells(1, col).Value = wdate」、日付2行目は「sh1.Cells(2, col).Value = WeekdayName(wkday, True)」のコード記述になります。
3)この管理表では横に1ヵ月分としています。
4)1人の休みの曜日は2日分で固定ではありません。3日の方もいれば4日の人もいます。
5)はい、Cさんの下にDさん、Eさんと続きます。
図2の方が使い易いと思いました!
こちらでお願い致します。

よろしくお願い致します。

お礼日時:2017/05/12 13:32

こんにちは!



一例です。
↓の画像のように別シートに個人の「固定休」の表を作成しておきます。
そして、Sheet1のB3セルに
=IF(ISNUMBER(FIND(B$2,VLOOKUP($A3,Sheet2!$A:$B,2,0))),"休","")

という数式を入れフィルハンドルで列・行方向にコピーすると
画像のような感じになります。

※ Sheet1の2行目(曜日行)はシリアル値で表示形式を「aaa」としているのではなく
文字列で日~土が入っているとします。m(_ _)m
「VBAシフト表における従業員の固定休のプ」の回答画像3
    • good
    • 0

=if(or(b2="月",b2="金"),"休"," ")


この式をAさんの行にペーストし、Bさんには月→水、金→土、と改良して、ペーストすればVB使わなくても出来ませんか?
    • good
    • 0

補足してください。



火曜日は定休日なのですか?
この回答への補足あり
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

Q入力セルから入力セルに罫線をひく

BBAでお聞きします。
セルB3「あ」が入力してあり、F5に「い」が入力してあるとします。B3;F5まで罫線をマクロ設定後、ボタンを作成して記入できますでしょうか。
Excelで「B3」を選択後、shift+ctrl+endで「F5」まで指定後、相対マクロで記憶させます.その後、1度クリアー後、再度「B4」から「F4」まで選択しますとF5まで罫線が引かれます。
記入セルから記入セルまでの罫線の引く、VBAをご教授ください。
宜しくお願いします。

Aベストアンサー

質問の主旨が良くわからないが、
ーー
具体的に範囲を指定してマクロの記録をとる(田の字状の罫線を引いた)と
Sub Macro1()
  Range("B2:D5") Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
  ・・・・
End With
End Sub
となるが、
Range("B2:D5") Select
の行を取り除き、コマンドボタンのクリックイベントに入れる(登録する)と、どうですか。
これでは充足されない点を補足してください。

Qセルに入力すると隣のセルに日付が入力される コード訂正願い

お世話になります。
VBA初心者の者です。
タイトルの通りのなのですが、以下の通りコードを作りました。
A列に文字が入力されると、F列に日付が入力されることを目指して成功しています。
しかし、ここで AとE列同時にデータをペーストすると、なぜかB列に日付が
入ってしまいます。
どのように変化させれば宜しいでしょうか。
ご教授下さい。よろしくお願い致します。 (※ excel2003を使用)

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If Cells(Target.Row, 1).Value <> "" Then Status = Date Else Status = ""
If TypeName(Target.Value) <> "Variant()" Then Cells(Target.Row, 6).Value = Status Else _
For i = 0 To UBound(Target.Value) - 1: Cells(Target.Row + i, 2).Value = Status: Next
End If
End Sub

お世話になります。
VBA初心者の者です。
タイトルの通りのなのですが、以下の通りコードを作りました。
A列に文字が入力されると、F列に日付が入力されることを目指して成功しています。
しかし、ここで AとE列同時にデータをペーストすると、なぜかB列に日付が
入ってしまいます。
どのように変化させれば宜しいでしょうか。
ご教授下さい。よろしくお願い致します。 (※ excel2003を使用)

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If Cells(Target.Row,...続きを読む

Aベストアンサー

For...Nextの間でB列に日付を設定しているようですが、これは意図したものではないのですか?
コードを見ただけでは何がしたいのか不明です。(特にFor...Nextの間)
仕様の説明をお願いします。

QExcel マクロ VBA 別シートのセルを検索し、該当するセルの右にあるセルを入力させる方法 s

Excel マクロ VBA 別シートのセルを検索し、該当するセルの右にあるセルを入力させる方法

sheet『品名マスタ』にはA列に№、B列に商品名があります。sheet『一覧』のB列7行目以降に№が入っています。
※この№が重複することはありません。

『一覧』B列7行目以降にある№で『品名マスタ』A列の№を検索し、該当する『品名マスタ』B列の商品名を『一覧』のC列7行目に反映する。
『一覧』B列の№が空欄の場合は何も入れない。

という処理のボタンをつけたいのですが、どなたか詳しい方ご教授いただけないでしょうか?
(OS:Windows7 Excel:2010を使用しております。)

Aベストアンサー

こんにちは。
以下を試してみてください。

>処理のボタンをつけたい
マクロ名は任意です。Match関数を利用しています。

'//
Sub Button1_Click()  '←ここは任意
Dim c, i
Dim Sh1 As Worksheet: Set Sh1 = Worksheets("一覧")
Dim Sh2 As Worksheet: Set Sh2 = Worksheets("品名マスタ")
With Sh1
 For Each c In .Range("B7", .Cells(Rows.Count, 2).End(xlUp))
  If IsNumeric(c.Value) Then
   i = Application.Match(c.Value, Sh2.Columns(1), 0)
   If IsNumeric(i) Then
    c.Offset(, 1).Value = Sh2.Cells(i, 2).Value
   End If
  End If
 Next c
End With
End Sub

-----------
この種の質問では定番ですが、イベント・ドリブン型マクロがありますので、それも加えておきます。一覧のB列に数字を入れると、自動的に商品名が出てきます。Vlook関数とは似ていますが、違うのは、数字を消すと、右隣のセルの内容も消えます。

'//シートモジュール(シートタブを右クリック、コードの表示)

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim i As Variant '数値型ではありません
 Dim buf As String
 Dim Sh1 As Worksheet: Set Sh1 = Worksheets("品名マスタ")
 If Target.Count > 1 Then Exit Sub
 With Target
 If .Column <> 2 Then Exit Sub
 If .Row < 7 Then Exit Sub
 '数字を削除すると、隣の文字が消える
 If .Value = "" Then Target.Offset(, 1).ClearContents: Exit Sub
  If IsNumeric(.Value) Then
   i = Application.Match(.Value, Sh1.Columns(1), 0)
   If IsNumeric(i) Then
    buf = Sh1.Cells(i, 2).Value
    Application.EnableEvents = False
    .Offset(, 1).Value = buf
    Application.EnableEvents = True
    buf = ""
   End If
  End If
 End With
End Sub

こんにちは。
以下を試してみてください。

>処理のボタンをつけたい
マクロ名は任意です。Match関数を利用しています。

'//
Sub Button1_Click()  '←ここは任意
Dim c, i
Dim Sh1 As Worksheet: Set Sh1 = Worksheets("一覧")
Dim Sh2 As Worksheet: Set Sh2 = Worksheets("品名マスタ")
With Sh1
 For Each c In .Range("B7", .Cells(Rows.Count, 2).End(xlUp))
  If IsNumeric(c.Value) Then
   i = Application.Match(c.Value, Sh2.Columns(1), 0)
   If IsNumeric(i) Then
    c.Offset(, 1)...続きを読む

QVBAでマクロを走らせた日時をSheet2のAセルに入力する

VBAでマクロを走らせた日時をSheet2のAセルに入力する
はじめまして。
現在、ファイルを整理するマクロを使っています。
そのマクロを使った履歴を残す意味で、
いつマクロを走らせたかすぐにわかるように、
Sheet2のAのセル(2行目から)に走らせた日時を示したいと思っています。
マクロでの処理が終わったら、
毎回Sheet2に日時が入力されるようにするには、
どんな命令文を追記したらよいのでしょうか。
マクロに関しては知識がなく、
インターネットで調べて、
Sheets("Sheet2").Cells(R, "A").Value = Now
というのを追記してみたのですが、
Sheet2に入力はされるものの、
Aセルの行がとびとびに入力されたり、
整理したファイルの数だけ(複数)入力されてしまいます。
マクロを1回走らせたら1つの日時が入力されるようにしたいです。
Sub ()とEnd Subの間にFor RとNext Rがあり、
作業が繰り返されているようです。
転記ができないため、マクロを示すことができません。
さすがに、これだけの情報では難しいでしょうか。
わかるかたがいらっしゃいましたら、
よろしくおねがいします。

VBAでマクロを走らせた日時をSheet2のAセルに入力する
はじめまして。
現在、ファイルを整理するマクロを使っています。
そのマクロを使った履歴を残す意味で、
いつマクロを走らせたかすぐにわかるように、
Sheet2のAのセル(2行目から)に走らせた日時を示したいと思っています。
マクロでの処理が終わったら、
毎回Sheet2に日時が入力されるようにするには、
どんな命令文を追記したらよいのでしょうか。
マクロに関しては知識がなく、
インターネットで調べて、
Sheets("Sheet2").Ce...続きを読む

Aベストアンサー

worksheets("sheet2").cells(rows.count,1).end(xlup).offset(1).value=now

end sub
の前に追加

参考まで

QA1セル入力値をファイル名先頭に追加したい。

マクロ初心者で色々な事例を組み合わせて次のマクロを
作成しました。
A.xlsを開いて一部加工したファイルをB.xlsで保存し
さらに一部を消去しC.xlsで保存するマクロです。
今回、B.xlsおよびC.xlsの先頭にA.xlsのA1セルに入力
された6桁の数字を付加して保存したいのですが・・・。
例えばA1セルが123456の時は
123456B.xls
123456C.xls
どなたか教えてください。

現在のマクロ
Sub Macro2()

Dim strFilePath As String
Dim strFileName As String
Dim flg As Boolean
'◆保存するパスの設定
strFilePath = ThisWorkbook.Path & "\"
'◆保存するファイル名の指定
strFileName = "B"
On Error Resume Next
Workbooks(strFileName).Activate
ThisWorkbook.SaveAs strFilePath & strFileName
'◆個人情報消去
Range("D42:E49").Select
Selection.ClearContents
Range("d1").Select
strFileName = "C"
ThisWorkbook.SaveAs strFilePath & strFileName
Application.Quit
End Sub

マクロ初心者で色々な事例を組み合わせて次のマクロを
作成しました。
A.xlsを開いて一部加工したファイルをB.xlsで保存し
さらに一部を消去しC.xlsで保存するマクロです。
今回、B.xlsおよびC.xlsの先頭にA.xlsのA1セルに入力
された6桁の数字を付加して保存したいのですが・・・。
例えばA1セルが123456の時は
123456B.xls
123456C.xls
どなたか教えてください。

現在のマクロ
Sub Macro2()

Dim strFilePath As String
Dim strFileName As String
Dim flg As Boolean
'◆保存するパスの設定
strFilePath = Thi...続きを読む

Aベストアンサー

参考に
Dim strFilePath As String
Dim strFileName As String
strFilePath = ThisWorkbook.Path & "\"
With ThisWorkbook
  strFileName = .Worksheets("Sheet1").Range("A1").Value
  .SaveCopyAs strFilePath & strFileName & "B.xls"
  'シート名も明記のこと
  .Worksheets("Sheet1").Range("D42:E49").ClearContents
  .Worksheets("Sheet1").Range("d1").Select
  .SaveCopyAs strFilePath & strFileName & "C.xls"
  .Saved = True
End With
Application.Quit


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報