概要
弊社(現部署)での主な作業の一つである、求人データの選定作業となります。
下記のような求人データから、
応募数獲得が見込める選定ロジックに則って、オートフィルターを駆使して指定件数分データを選定する
というものです。
※右側：選定エリア×選定数
今回は以下選定ロジックにて、
応募数獲得が見込める求人を「案件選定数確認」シートに記載されている
都道府県毎×アルファベット(D～A)件数分、選定致します。
※「東京都」ならば以下件数分となります。
D3件
C100件
B300件
A200件
選定ロジック
※前提：時給降順で選定
→D列「時給」を降順ソート
- B列「都道府県」にて選定したい都道府県を抽出
→「東京都」を選定する場合は「東京都」で抽出 - 応募数1以上(降順)
→C列「応募数」を1以上で抽出して選定 - 未経験OK
→E列「未経験」を「●」で抽出して選定 - 職種未経験OK
→F列「職種未経験」を「●」で抽出して選定 - 時給降順
→最初にD列「時給」が既に降順ソートされている為、上行から選定 - 1～5作業を選定したい都道府県全てに対し繰り返す
※上記画像の場合「東京都」「神奈川県」「埼玉県」「千葉県」の4エリア分繰り返す
文章だけでは「どのように作業するのか」がピンと来ないと思いますので、
動画で「東京都」のみ手作業で選定した動画を載せております。
下記動画をご確認頂けますと、内容が理解し易くなると思います。
プログラムを作成した理由
上記のような求人の選定作業が現部署での主な作業の一つであり、
私の初業務となりましたが、
2万件以上ある求人データから、合計で5000件選定
※47都道府県全てに対し、選定上限数が決められている
※選定ロジックは1～10にも及ぶ
という面倒かつ、
膨大な単純作業の繰り返しというものでした。
慣れない作業という事もあり、
毎日6時間かかっておりました…！
※作業ミスもあり、何度も先輩社員に叱られました…( ;∀;)
毎日虚無を感じながら、
手が腱鞘炎になるかと思うくらいオートフィルターを駆使して
選定していたのですが、
「こんな何のスキルにもならない単純作業を毎日毎日6時間かけてるのか…」
と本当に嫌気がさしました…
入社当時はExcelVBA素人でしたが、
「こんな拷問みたいな作業やってられるか…！！！自動化してやる！！！」
と強く決心したのがキッカケです。
ソースコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | Option Explicit '概要：エリア(都道府県)毎に指定件数分、下記選定ロジックに従って選定する '◆選定ロジック '前提: 時給降順で選定 '選定ロジック①_応募1以上 '選定ロジック②_未経験 '選定ロジック③_職種未経験 '選定ロジック④_時給降順 Sub 選定() '変数定義 Dim 選定数 As Integer Dim 残選定数 As Integer Dim Area_Name As String Dim InputAlpha As String 'リスト関数 Dim RemainFlgList() As RemainFlg_List 'ループカウンタ Dim InputAlpha_Count As Integer Dim Salary_Count As Integer Dim RemainFlg_Count As Integer Dim Logic_Count As Integer 'シート設定 Set 選定シート = Worksheets(選定シート名) Set 案件選定数確認シート = Worksheets(案件選定数確認シート名) With Application .DisplayStatusBar = True 'ステータスバー表示 .StatusBar = "" 'ステータスバー文言初期化 .Calculation = xlCalculationManual '手動計算に .ScreenUpdating = False '画面描画を停止 End With '選定前準備 With 選定シート 'オートフィルター解除 .AutoFilterMode = False 'A2で「Ctrl+Shift+End」したのと同じ操作 .Range(.Range("A2"), .Range("A2").SpecialCells(xlLastCell)).Copy '値貼付 .Range("A2").PasteSpecial Paste:=xlPasteValues 'コピーモードオフ Application.CutCopyMode = False 'D列「時給」降順ソート Call Sort(選定シート, 時給_列位置, False) 'C列「応募数」降順ソート Call Sort(選定シート, 応募数_列位置, False) 'フォーカス初期化 .Range("A1").Select End With '残フラグ取得 Call RemainFlgSet(RemainFlgList) 'D、C、B、Aの4回ループ For InputAlpha_Count = 1 To 4 '都道府県ループ For RemainFlg_Count = LBound(RemainFlgList) To UBound(RemainFlgList) With RemainFlgList(RemainFlg_Count) 'エリア名 Area_Name = .Area_Name '残フラグ数設定 Select Case InputAlpha_Count 'D Case 1 残選定数 = .D_RemainFlg '選定入力値 InputAlpha = "D" 'C Case 2 残選定数 = .C_RemainFlg '選定入力値 InputAlpha = "C" 'B Case 3 残選定数 = .B_RemainFlg '選定入力値 InputAlpha = "B" 'A Case 4 残選定数 = .A_RemainFlg '選定入力値 InputAlpha = "A" '想定外 Case Else MsgBox "D～A以外では選定を行いません。処理を中止します。" End End Select End With 'ステータスバー更新 Application.StatusBar = "「" & Area_Name & "」「" & InputAlpha & "」選定中…" DoEvents With 選定シート '残選定数1以上の場合、選定開始 If 残選定数 > 0 Then '初期化 選定数 = 0 '選定ロジック1～4の4回ループ For Logic_Count = 1 To 4 '選定ロジック進行状況確認の為のステータスバー更新 '例)「選定中…◆◆」ならば選定ロジック2番目実行中 Application.StatusBar = Application.StatusBar & "◆" DoEvents 'オートフィルター解除 .AutoFilterMode = False '未選定案件 .Cells(1, 選定_列位置).AutoFilter Field:=選定_列位置, Criteria1:="" '都道府県 .Cells(1, 都道府県_列位置).AutoFilter Field:=都道府県_列位置, Criteria1:=Area_Name Select Case Logic_Count '選定ロジック①_応募1以上 Case 1 '応募1以上 .Cells(1, 応募数_列位置).AutoFilter Field:=応募数_列位置, Criteria1:=">=1" '選定実行 選定数 = SelectionFlgSet(選定_列位置, InputAlpha, 残選定数) '選定ロジック②_未経験 Case 2 '未経験 .Cells(1, 未経験_列位置).AutoFilter Field:=未経験_列位置, Criteria1:="●" '選定実行 選定数 = SelectionFlgSet(選定_列位置, InputAlpha, 残選定数) '選定ロジック③_職種未経験 Case 3 '職種未経験 .Cells(1, 職種未経験_列位置).AutoFilter Field:=職種未経験_列位置, Criteria1:="●" '選定実行 選定数 = SelectionFlgSet(選定_列位置, InputAlpha, 残選定数) '選定ロジック④_時給降順 Case 4 '選定実行 '※既に時給降順でソートされている為、何も抽出せず実行 選定数 = SelectionFlgSet(選定_列位置, InputAlpha, 残選定数) 'ロジック実装ミス Case Else MsgBox "【想定外エラー】" & vbLf & _ "選定ロジック「" & Logic_Count & "」が指定されました。処理を停止しました。" End End Select '選定後結果更新 残選定数 = 残選定数 - 選定数 '選定終了判定 If 残選定数 = 0 Then 'オートフィルター解除 .AutoFilterMode = False '次の選定へ移行 Exit For End If Next End If '選定完了しなかった場合、警告メッセージ表示 If 残選定数 <> 0 Then MsgBox "「" & Area_Name & "」" & vbLf & _ 残選定数 & "件不足しています。実行完了後に確認して下さい。" End If End With Next Next '選定終了後処理 選定シート.Range("A1").Select With Application .StatusBar = "" 'ステータスバー文言初期化 .ScreenUpdating = True '画面描画を開始 .Calculation = xlCalculationAutomatic '自動計算に End With '完了メッセージ MsgBox "完了致しました！" End Sub |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | Option Explicit '残案件数更新 Public Sub RemainFlgSet(RemainFlgList() As RemainFlg_List) '変数定義 Dim EndRow As Integer 'ループカウンタ Dim i As Integer With 案件選定数確認シート 'シート内再計算 .Calculate '最終行(1行目の空白行や、2行目の項目名含む) EndRow = .Cells(案件選定数確認_開始行数 - 1, 1).End(xlDown).Row '1行目の空白行、項目行を除いた処理行数 EndRow = EndRow - (案件選定数確認_開始行数 - 1) '残フラグ配列更新 ReDim RemainFlgList(EndRow - 1) '残フラグ設定 For i = LBound(RemainFlgList) To UBound(RemainFlgList) '群No RemainFlgList(i).Area_Name = .Cells(案件選定数確認_開始行数 + i, 1).Value '残選定数更新 RemainFlgList(i).D_RemainFlg = .Cells(案件選定数確認_開始行数 + i, 案件選定数確認_D残り選定数_列位置).Value RemainFlgList(i).C_RemainFlg = .Cells(案件選定数確認_開始行数 + i, 案件選定数確認_D残り選定数_列位置 + 1).Value RemainFlgList(i).B_RemainFlg = .Cells(案件選定数確認_開始行数 + i, 案件選定数確認_D残り選定数_列位置 + 2).Value RemainFlgList(i).A_RemainFlg = .Cells(案件選定数確認_開始行数 + i, 案件選定数確認_D残り選定数_列位置 + 3).Value Next End With End Sub '列ナンバーをアルファベット列名に変換 Public Function GetAlphaName(ColomnNum As Integer) As String '変数定義 Dim ColomnName As String '列位置→アルファベット列名変換 ColomnName = Cells(1, ColomnNum).Address(True, False) ColomnName = Left(ColomnName, InStr(2, ColomnName, "$") - 1) '返却値 GetAlphaName = ColomnName End Function '対象シート：フラグオプション選択列に、選定値をセット '第一引数：対象シート名 '第二引数：選定入力値 '第三変数：上限 Public Function SelectionFlgSet(入力位置 As Integer, ByVal InputNum As String, ByVal Limit As Long) As Long '変数定義 Dim FilterRow As Range Dim IntLastLow As Long Dim 選定数 As Long With 選定シート '項目除いた抽出案件数 IntLastLow = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).COunt - 1 '抽出案件無し If IntLastLow = 0 Then Exit Function End If '可視セルのみ実行 For Each FilterRow In .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible) '項目以外実行 If FilterRow.Row <> 1 Then '抽出された行に対して処理を記述 '上限チェック If 選定数 = Limit Then '返却値 SelectionFlgSet = 選定数 Exit Function End If '選定値入力 .Cells(FilterRow.Row, 入力位置).Value = InputNum 選定数 = 選定数 + 1 End If Next FilterRow End With '返却値 SelectionFlgSet = 選定数 End Function '概要：指定セルを列項目名とし、ソートする '第一引数：ソート実行シート '第二引数：指定項目列位置 '第三引数：昇順フラグ(False時、降順設定) Public Sub Sort(対象シート As Worksheet, Target_Column As Integer, OrderByOn As Boolean) Dim Order As Integer Dim Target_Header As String '並び替え対象項目作成 Target_Header = GetAlphaName(Target_Column) & "1" '並び替えフラグ設定 If OrderByOn Then Order = xlAscending '昇順 Else Order = xlDescending '降順 End If With 対象シート 'オートフィルターされていない場合は、設定する If Not .AutoFilterMode Then .Range("A1").AutoFilter End If 'ソートクリア .AutoFilter.Sort.SortFields.Clear '指定列並び替え設定 .AutoFilter.Sort.SortFields.Add Key:=Range(Target_Header), _ SortOn:=xlSortOnValues, Order:=Order, DataOption:=xlSortNormal With .AutoFilter.Sort .Header = xlYes '先頭行をタイトル行とする .MatchCase = False '大文字小文字区別しない .Orientation = xlTopToBottom '行の並び替え .SortMethod = xlPinYin '音読み順(日本語が含まれていた時) .Apply '実行 End With End With End Sub |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | Option Explicit 'ユーザー関数------------------------------------------------ Type RemainFlg_List Area_Name As String D_RemainFlg As Integer C_RemainFlg As Integer B_RemainFlg As Integer A_RemainFlg As Integer End Type '定数-------------------------------------------------------- 'シート定義 Public Const 選定シート名 As String = "選定" Public Const 案件選定数確認シート名 As String = "案件選定数確認" Public 選定シート As Worksheet Public 案件選定数確認シート As Worksheet '選定シート_列位置定義 Public Const 選定_列位置 As Integer = 1 'A列 Public Const 都道府県_列位置 As Integer = 2 'B列 Public Const 応募数_列位置 As Integer = 3 'C列 Public Const 時給_列位置 As Integer = 4 'D列 Public Const 未経験_列位置 As Integer = 5 'E列 Public Const 職種未経験_列位置 As Integer = 6 'F列 '案件選定数確認_行位置定義 Public Const 案件選定数確認_開始行数 As Integer = 2 '案件選定数確認_列位置定義 Public Const 案件選定数確認_D残り選定数_列位置 As Integer = 6 'F列 |
導入方法
実際にマクロを動かしたい方、ツールを見たい方は
以下からダウンロードして実行してみて下さい。
ダウンロードしたツールのプロパティを開く
「セキュリティ」の「許可する」にチェックし、
「適応」「OK」ボタンを押す
この作業を行う事でツールが動くようになります。
感想
マクロを実行するだけで全エリア(都道府県)が選定完了する為、
作業時間が 6時間 → 1分 と大幅に作業時間が削減されました。
作業時間短縮だけでなく、
作業ミスが発生しなくなった事よる安心感も大きかったです。
拷問のような作業から解放されて喜んだのも束の間、
「選定作業自動化出来るのですね、じゃあこの選定も自動化お願い致します」
と幾重にも及ぶ選定作業の自動化を行う羽目になりました( ;∀;)
様々なタイプの選定作業の自動化がありましたが…
数年間、ExcelVBAを使い続けていくうちに
「オートフィルターする列や内容(数値、文字)が違うだけでほぼ過去ツールのコピペ」
で済むようになりました。
余談
当初は頼られる事にやりがいを感じておりましたが、
次第に「毎日毎日同じツール作成の繰り返し…この世(現部署)は腐っている」
と退屈に感じてやる気を無くしていきました←
「やる気低下を自覚してながら、新しい行動をしないのは精神的に良くない」と感じ、
「何か興味のあるプログラム言語、自動化はないかな？」とyoutubeで検索したところ、
「Pythonを使ってブラウザからファイルを自動ダウンロード」している下記動画を見て
「Python全然知らないけど、これなら私にも出来そう！」
「現部署で革命が起こせるぞ！」
とPythonにハマっていったので、結果的には良かったのかも知れません(笑)
Pythonに出会って約2年、ダウンロードだけでなく、アップロードも出来るようになりました！
ご興味のある方は下記記事をご覧下さい。
編集履歴
2021/01/09 新規作成
