前提
VBAで今日現在および任意の日の社員名簿を出力するマクロを作っています。
以下の5シートを使用します。
- 異動DB
- 組織マスター
- 社員基本情報
- 社員名簿
- 今日現在の社員名簿
異動DB
組織マスター
社員基本情報
社員名簿
今日現在の社員名簿
以下のURLを参考にしています。
・社員名簿を作る~その2~
また、今回は以前に以下のURLで質問し回答いただいた内容の続きです。
・過去の質問
該当のソースコード
「異動DB」「組織マスター」「社員基本情報」を参照して、
- 過去または未来の特定の日付⇒「社員名簿」
- 今日の日付⇒「今日時点の社員名簿」
に書き込むコードです。
VBA
1Sub meibokosin(d As Date, c As Collection, ByVal out_type As Long) 2 '複数枚のシートを合わせて並び替えた社員名簿を作る 3 'out_type 1:任意の日の社員名簿 4 'out_type 2:今日時点の社員名簿 5 6 Dim kubun As Integer, today_d As Date, str_d As Date, end_d As Date 7 Dim no As Integer, syain_no As Long 8 Dim honbu As String, bu As String, ka As String, kakari As String 9 Dim sosikicode As Long, kakuzuke As String, kakuzuke_code As Long 10 Dim yakusyoku As String, yakusyoku_code As Integer, simei As String, seibetu As String, seinengappi As Long, nyusyabi As Long, _ 11 mailadd As String, gakureki As String, kenpo_no As String, nenkin_no As String, kisonenkin_no As String 12 Dim honbucode As Long, syozoku As String, syozoku_code As Long 13 14 Const AddCol As Long = 128 '追加列数 15 Dim aval(AddCol - 1) As Variant '追加列分格納領域 16 Dim i As Long '添え字 17 18 Dim wS1 As Worksheet 19 Dim wS2 As Worksheet 20 Dim wS3 As Worksheet 21 Dim wS4 As Worksheet 22 23 'ワークシートを変数で宣言する 24 Set wS1 = Worksheets("異動DB") 25 Set wS2 = Worksheets("組織マスター") 26 Set wS3 = Worksheets("社員基本情報") 27 If out_type = 1 Then 28 Set wS4 = Worksheets("社員名簿") 29 End If 30 If out_type = 2 Then 31 Set wS4 = Worksheets("今日時点の社員名簿") 32 End If 33 34 'ワークシートに出力している間の画面更新を停止 35 Application.ScreenUpdating = False 36 wS4.Activate 37 38 '前の結果をクリアする 39 If n > 2 Then 40 wS4.Range(wS4.Cells(3, 1), wS4.Cells(n, 151)).ClearContents 41 wS4.Range(wS4.Cells(3, 1), wS4.Cells(n, 151)).Borders.LineStyle = xlLineStyleNone 42 End If 43 44 '各シートの値を変数にセットする 45 For m = 1 To c.Count 46 R = c(m) 47 48 '「異動DB」 49 With wS1 50 today_d = d 51 kubun = .Cells(R, 1) 52 str_d = .Cells(R, 2) 53 end_d = .Cells(R, 3) 54 no = R 55 syain_no = .Cells(R, 4) 56 simei = .Cells(R, 5) 57 honbu = .Cells(R, 6) 58 bu = .Cells(R, 7) 59 ka = .Cells(R, 8) 60 kakari = .Cells(R, 9) 61 kakuzuke = .Cells(R, 10) 62 yakusyoku = .Cells(R, 11) 63 syozoku = .Cells(R, 12) 64 End With 65 66 '「社員基本情報」 67 Set rcd = wS3.Range("a:a").Find(syain_no, lookat:=xlWhole) 68 If Not rcd Is Nothing Then 69 seibetu = rcd.Offset(0, 2) 70 seinengappi = rcd.Offset(0, 3) 71 nyusyabi = rcd.Offset(0, 4) 72 mailadd = rcd.Offset(0, 5) 73 gakureki = rcd.Offset(0, 6) 74 kenpo_no = rcd.Offset(0, 7) 75 nenkin_no = rcd.Offset(0, 8) 76 kisonenkin_no = rcd.Offset(0, 9) 77 78 For i = 0 To UBound(aval) 79 aval(i) = rcd.Offset(0, 10 + i) 80 Next 81 End If 82 83 '「組織マスター」 84 With wS2 85 Set rcd_honbu = .Range("a:a").Find(honbu, lookat:=xlWhole) 86 Set rcd_bu = .Range("c:c").Find(bu, lookat:=xlWhole) 87 Set rcd_ka = .Range("e:e").Find(ka, lookat:=xlWhole) 88 Set rcd_kakari = .Range("g:g").Find(kakari, lookat:=xlWhole) 89 90 Set rcd_kakuzuke = .Range("k:k").Find(kakuzuke, lookat:=xlWhole) 91 kakuzuke_code = rcd_kakuzuke.Offset(0, 1) 92 93 Set rcd_yakusyoku = .Range("m:m").Find(yakusyoku, lookat:=xlWhole) 94 yakusyoku_code = rcd_yakusyoku.Offset(0, 1) 95 96 Set rcd_syozoku = .Range("i:i").Find(syozoku, lookat:=xlWhole) 97 syozoku_code = rcd_syozoku.Offset(0, 1) 98 End With 99 100 101 Dim arr() As Variant 102 Dim flag As Boolean 103 flag = False 104 If out_type = 1 Then 105 '退職(区分:3)を除く任意の日の各社員データを書き込む 106 If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or _ 107 (str_d <= today_d And end_d = 0) Or _ 108 (kubun <> 3 And str_d > today_d And end_d = 0) Then 109 flag = True 110 End If 111 End If 112 If out_type = 2 Then 113 '今日現在の各社員データを書き込む 114 If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or _ 115 (str_d <= today_d And end_d = 0) Then 116 flag = True 117 End If 118 End If 119 If flag = True Then 120 ReDim Preserve arr(151, p) 121 arr(0, p) = no 122 arr(1, p) = syain_no 123 arr(2, p) = honbu 124 arr(3, p) = bu 125 arr(4, p) = ka 126 arr(5, p) = kakari 127 arr(6, p) = sosikicode 128 arr(7, p) = kakuzuke 129 arr(8, p) = kakuzuke_code 130 arr(9, p) = yakusyoku 131 arr(10, p) = yakusyoku_code 132 arr(11, p) = simei 133 arr(12, p) = seibetu 134 arr(13, p) = seinengappi 135 arr(14, p) = nyusyabi 136 arr(15, p) = mailadd 137 arr(16, p) = gakureki 138 arr(17, p) = kenpo_no 139 arr(18, p) = nenkin_no 140 arr(19, p) = kisonenkin_no 141 arr(20, p) = honbucode 142 arr(21, p) = syozoku 143 arr(22, p) = syozoku_code 144 For i = 0 To UBound(aval) 145 arr(23 + i, p) = aval(i) 146 Next 147 148 p = p + 1 149 End If 150 Next m 151 152 With wS4.Range("a3").Resize(p, 151) 153 .Value = Application.WorksheetFunction.Transpose(arr) 154 End With 155 156 Application.ScreenUpdating = True 157End Sub
発生している問題
上記のコードで希望通り、任意の日の社員名簿が出力できました。
マクロをレビューした際、「条件を増やしました」と説明した際、実際のコードは見せておらず、説明不足だったためか、レビュー担当者から、
「条件を増やし過ぎていないか?」「条件を1~2文まで減らせば済むのでは?」と指摘を受けました。
実現したいこと
任意の日を出力する(out_type = 1)条件は以下の通りですが、これをなるべく簡潔にしたいです。
- 区分≠3 かつ 開始日<=今日 かつ 今日<=終了日
- 開始日<=今日 かつ 終了日<=0
- 区分≠3 かつ 開始日>今日 かつ 終了日<=0
試したこと
104~111行目の out_type = 1 の条件分岐で、以下のように「退職(区分:3)を除く」のみとして書きかえて実行しました。
If out_type = 1 Then '退職(区分:3)を除く任意の日の各社員データを書き込む If (kubun <> 3) Then flag = True End If End If
実行後の社員名簿を見ると一見問題なさそうですが、
この場合だと、未来の日に退職する社員が表示されないような気がします。
やはり元のコードで理解して貰うまできちんと説明すべきでしょうか。
コードというよりも論理的な質問ですが、どのように説明すれば通用するかアドバイスいただければと思います。よろしくお願いいたします。
補足情報(FW/ツールのバージョンなど)
PC:Windows11
Excelのバージョン:Microsoft365 Excel
コメントを受けて追記
異動DBのサンプルです。
※区分は0:初期状態、1:新規入社、2:異動、3:退職です。
※サンプルでは、2022/12/31にEさんが退職、2023/4/1にCさんが異動、Fさんが新規入社した場合です。
区分 | 開始日 | 終了日 | 社員番号 | 氏名 | 支社 | 本部 | 部 | 課 | M | 役職 | 所属 |
---|---|---|---|---|---|---|---|---|---|---|---|
0 | 2022/12/1 | 1 | A | 本社 | 管理本部 | 総務部 | - | - | 部長 | 本社管理本部総務部 | |
0 | 2022/12/1 | 2 | B | 本社 | 管理本部 | 総務部 | 総務課 | - | 課長 | 本社管理本部総務部総務課 | |
0 | 2022/12/1 | 2023/3/31 | 3 | C | 本社 | 管理本部 | 総務部 | 総務課 | - | 一般 | 本社管理本部総務部総務課 |
0 | 2022/12/1 | 4 | D | 本社 | 管理本部 | 総務部 | 人事課 | - | 課長 | 本社管理本部総務部人事課 | |
0 | 2022/12/1 | 2022/12/31 | 5 | E | 本社 | 管理本部 | 総務部 | 人事課 | - | 一般 | 本社管理本部総務部人事課 |
3 | 2023/1/1 | 5 | E | 本社 | 管理本部 | 総務部 | 人事課 | - | 一般 | 本社管理本部総務部人事課 | |
2 | 2023/4/1 | 3 | C | 本社 | 管理本部 | 総務部 | 人事課 | - | 一般 | 本社管理本部総務部人事課 | |
1 | 2023/4/1 | 6 | F | 本社 | 管理本部 | 総務部 | 人事課 | - | 派遣 | 本社管理本部総務部人事課 |

回答1件
あなたの回答
tips
プレビュー