6
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

非効率な名簿管理を楽にしよう!デジタル初心者がマクロという武器⚔を手に入れた!

Last updated at Posted at 2025-09-08

こんにちは。某小売業で働くMasukoです。
今回は初!Excelでマクロを使ってみたよっっ!のお話です。

今回マクロ(VBA)に挑戦した理由

今回作るツールを自部署メンバー全員に使用してもらいたい!
アプリダウンロードやアカウント作成など手間がかかる事があると使ってくれない。それなら皆が使用しているExcelで出来る事が一番だっ!!

Excel業務を効率化したいから、マクロを使いこなしたい!
関数だけじゃなく、もっと効率のいい方法を見つけたいのよ🥺

Excelとのお付き合いは大学の時からですが、本格的に使うようになったのはここ5年位。といっても難しいことをするわけでもなく簡単な関数を使う程度。もっぱらXLOOKUP関数にお世話になっております。
マクロにも興味はあったけど「難しそう…」と敬遠していました。
しかし!生成AIの力をお借りすれば可能なことを知りチャレンジしてみました!

そんな私の初作品!👇

何のツールなのかと言うと、
社員番号、もしくは店舗・氏名をもとに別の「従業員リスト」を参照し、従業員の情報が一発で表示されるというもの。

私は教育担当者として研修を開催したり、社内資格者の管理をしています。そこで重要となるのが名簿の管理。
研修を開催する時は店舗から受講生を募ります。その時エントリーシートに所属部署とお名前、社員番号を記入してもらうのですが、結構間違いがあるんですよね。(お名前の漢字が間違っていたり、社員番号が違ったり…)
また、異動で所属部署が変わっていることもある為、都度正しい情報かどうかチェックする必要があります。

社内システムにも従業員検索ツールはあるけれど、1人ずつしか検索ができない。(非効率😱)
1か月で研修にお呼びする受講者は約800名ほど。
研修担当者やアシスタントさんがチェックしているのだけれど、やっぱり人がやることには漏れがある…
正直時間もございません。なんとかならない?

こんなお悩みから、
「名簿の管理を正確に!簡単に!効率的に!」 をテーマに挑戦しました!

マクロ(VBA)初挑戦記録🗒

使用したもの

  • Excelシート
  • ChatGP(強い味方!)
  • 従業員リスト(Excelファイル)
     ↑これはリーダーが人事Gに依頼をして、もらうデータ。
     個人情報が入っているので取り扱い注意!

まず初めに言いたい。保存する時は拡張子に気をつけろ!

本格的に挑戦する前に、練習でコードを記入(正しくはChatGPTから貼り付け)。順調に進んだので一旦保存してファイルを閉じた後、意気揚々と再度ファイルを開けるとVBAコードが真っ白に消えていたという怪奇現象が発生👻

➡普通のExcelブック(.xlsx)で保存したらダメなのね。

通常のExcelブック(.xlsx)ではなく、マクロ有効ブック(.xlsm)に変更しないとコード消える。

💻マクロ作成手順

STEP1:Excelシートでマクロ機能の立ち上げ

Excelを開き下記の手順でVBAコードが記入できるBookを開きます。

STEP2:ChatGPT氏をお呼びする。(愛称チャッピー)

VBAコードは全てチャッピーに考えてもらいました🙌
こんな会話からスタート↓

最初に教えてもらったコード Option Explicit

Sub 転記処理()

Dim wbThis As Workbook        ' このブック
Dim wbSrc As Workbook         ' 元データのブック(Excel①)
Dim wsThis As Worksheet
Dim wsSrc As Worksheet
Dim fDialog As FileDialog
Dim srcPath As String
Dim lastRowThis As Long, lastRowSrc As Long
Dim i As Long
Dim rngFound As Range
Dim searchValue As Variant

Application.ScreenUpdating = False
Application.EnableEvents = False

Set wbThis = ThisWorkbook
Set wsThis = wbThis.Sheets(1) ' 必要に応じてシートを指定

' 同じフォルダ内にあるExcel①を開く
srcPath = wbThis.Path & "\Excel①.xlsx"  ' ファイル名は適宜修正してください
Set wbSrc = Workbooks.Open(srcPath)
Set wsSrc = wbSrc.Sheets(1) ' 元データのシートを指定

' 最終行の取得
lastRowThis = wsThis.Cells(wsThis.Rows.Count, "E").End(xlUp).Row
lastRowSrc = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

' E列をループして検索
For i = 2 To lastRowThis ' 2行目から処理(1行目が見出しの場合)
    searchValue = wsThis.Cells(i, "E").Value
    If searchValue <> "" Then
        Set rngFound = wsSrc.Range("A2:A" & lastRowSrc).Find(What:=searchValue, LookAt:=xlWhole)
        
        If Not rngFound Is Nothing Then
            ' 一致した行から値を転記
            wsThis.Cells(i, "G").Value = rngFound.Value               ' A列 → G列
            wsThis.Cells(i, "H").Value = rngFound.Offset(0, 1).Value  ' B列 → H列
            wsThis.Cells(i, "I").Value = rngFound.Offset(0, 5).Value  ' F列 → I列
        End If
    End If
Next i

' 元ブックを閉じる
wbSrc.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox "転記が完了しました!"

End Sub

最初は順調に進んでいたのですが、チャッピーと会話を繰り返すこと数時間。
こんなこともしたい!と要望を追加していくとだんだん話がかみ合わなくなり、1つ要望を追加するとさっきまで問題なくできていたことができなくなったり、何度も要望を伝えても叶わなかったり。
どこのコードまで順調に進んでいたか分からなく試行錯誤。

時にはイライラしてきて八つ当たり↓

(ごめんなさい)

やりたいことを後出しで追加追加してしまっていたので、
生成AIに依頼するときは事前にやりたいこと、順番を整理してから依頼することが大切だなと実感。

そんなこんなでやりたいこと90%は実現できた!🙌

約800名を検索するのにかかる時間はたったの10秒!!!🎉

簡単にExcelで実施していたこととマクロで実施している手順を比較してみました。
Excel業務はもっと効率的なものあるかもですが、私のレベルでは以下のような手順でした😂

最終のコードはこちら Option Explicit

Sub 転記処理完全版_5行目以降_社員番号補完()

Dim wbThis As Workbook, wbSrc As Workbook
Dim wsThis As Worksheet, wsSrc As Worksheet
Dim srcPath As String, srcFile As String
Dim lastRowThis As Long, lastRowSrc As Long
Dim i As Long, j As Long
Dim rngFound As Range
Dim empCol As Long
Dim headerCell As Range
Dim tmpStr As String
Dim searchValue As Variant
Dim errMsg As String
Dim valB As String, valC As String, valD As String, valE As String
Dim valG As String, valH As String, valI As String, valK As String
Dim sD As String, sI As String
Dim bVal As String, fVal As String
Dim foundFlag As Boolean

Const SrcPassword As String = "password"

Application.ScreenUpdating = False
Application.EnableEvents = False

Set wbThis = ThisWorkbook
Set wsThis = wbThis.Sheets(1)

' --------------------------
' シート保護解除
wsThis.Unprotect Password:=""

' 5行目以降のG~K列とM列をクリア(再実行用)
lastRowThis = wsThis.Cells(wsThis.Rows.Count, "E").End(xlUp).Row
wsThis.Range("G5:K" & lastRowThis).ClearContents
wsThis.Range("M5:M" & lastRowThis).ClearContents

' --------------------------
' 同フォルダ内のExcelファイルを検索
srcPath = wbThis.Path & "\"
srcFile = Dir(srcPath & "*.xls*")

Do While srcFile <> ""
    If srcFile <> wbThis.Name Then Exit Do
    srcFile = Dir()
Loop

If srcFile = "" Then
    MsgBox "同じフォルダ内に元データのExcelファイルが見つかりません。"
    GoTo EndProc
End If

' 元データブックを開く
Set wbSrc = Workbooks.Open(Filename:=srcPath & srcFile, Password:=SrcPassword)
Set wsSrc = wbSrc.Sheets(1)

' 「従業員番号」列を検索
Set headerCell = wsSrc.Rows(1).Find(What:="従業員番号", LookAt:=xlWhole)
If headerCell Is Nothing Then
    MsgBox "元データに『従業員番号』の見出しが見つかりません。"
    GoTo EndProc
End If
empCol = headerCell.Column

' 最終行取得
lastRowSrc = wsSrc.Cells(wsSrc.Rows.Count, empCol).End(xlUp).Row

' --------------------------
' 5行目以降ループ:転記・文字列クレンジング・赤文字チェック
For i = 5 To lastRowThis
    searchValue = wsThis.Cells(i, "E").Value
    errMsg = ""
    
    If searchValue <> "" Then
        Set rngFound = wsSrc.Range(wsSrc.Cells(2, empCol), wsSrc.Cells(lastRowSrc, empCol)) _
                      .Find(What:=searchValue, LookAt:=xlWhole)
        If Not rngFound Is Nothing Then
            ' 転記
            wsThis.Cells(i, "G").Value = wsSrc.Cells(rngFound.Row, 1).Value
            wsThis.Cells(i, "H").Value = wsSrc.Cells(rngFound.Row, 2).Value
            wsThis.Cells(i, "I").Value = wsSrc.Cells(rngFound.Row, 6).Value
            wsThis.Cells(i, "J").Value = wsSrc.Cells(rngFound.Row, 5).Value
            wsThis.Cells(i, "K").Value = wsSrc.Cells(rngFound.Row, 4).Value
            
            ' G列クレンジング
            tmpStr = CStr(wsThis.Cells(i, "G").Value)
            If InStr(tmpStr, "事業部") > 0 Then
                tmpStr = Replace(tmpStr, "西日本カンパニー", "")
                tmpStr = Replace(tmpStr, "事業部", "")
                wsThis.Cells(i, "G").Value = Trim(tmpStr)
            End If
            
            ' H列クレンジング
            tmpStr = CStr(wsThis.Cells(i, "H").Value)
            tmpStr = Replace(tmpStr, "イオンスタイル", "")
            tmpStr = Replace(tmpStr, "イオン", "")
            tmpStr = Replace(tmpStr, "店", "")
            wsThis.Cells(i, "H").Value = Trim(tmpStr)
        End If
    End If
    
    ' 相違チェック&赤文字
    valB = CStr(Trim(wsThis.Cells(i, "B").Value))
    valC = CStr(Trim(wsThis.Cells(i, "C").Value))
    valD = CStr(Trim(wsThis.Cells(i, "D").Value))
    valE = CStr(Trim(wsThis.Cells(i, "E").Value))
    valG = CStr(Trim(wsThis.Cells(i, "G").Value))
    valH = CStr(Trim(wsThis.Cells(i, "H").Value))
    valI = CStr(Trim(wsThis.Cells(i, "I").Value))
    valK = CStr(Trim(wsThis.Cells(i, "K").Value))
    
    sD = Replace(valD, " ", "")
    sD = Replace(sD, " ", "")
    sI = Replace(valI, " ", "")
    sI = Replace(sI, " ", "")
    
    ' B列比較(G列) → 事業部
    If valG <> "" And valB <> valG Then
        errMsg = errMsg & "事業部, "
        wsThis.Cells(i, "B").Font.Color = vbRed
    Else
        wsThis.Cells(i, "B").Font.Color = vbBlack
    End If
    
    ' C列比較(H列) → 店舗
    If valH <> "" And valC <> valH Then
        errMsg = errMsg & "店舗, "
        wsThis.Cells(i, "C").Font.Color = vbRed
    Else
        wsThis.Cells(i, "C").Font.Color = vbBlack
    End If
    
    ' D列比較(I列) → 氏名
    If valI <> "" And sD <> sI Then
        errMsg = errMsg & "氏名, "
        wsThis.Cells(i, "D").Font.Color = vbRed
    Else
        wsThis.Cells(i, "D").Font.Color = vbBlack
    End If
    
    ' M列にエラー表示
    If errMsg <> "" Then
        wsThis.Cells(i, "M").Value = Left(errMsg, Len(errMsg) - 2)
    End If
Next i

' --------------------------
' G~K列が全て空白の場合はM列に「社員番号」
For i = 5 To lastRowThis
    valG = CStr(Trim(wsThis.Cells(i, "G").Value))
    valH = CStr(Trim(wsThis.Cells(i, "H").Value))
    valI = CStr(Trim(wsThis.Cells(i, "I").Value))
    valK = CStr(Trim(wsThis.Cells(i, "K").Value))
    
    If valG = "" And valH = "" And valI = "" And valK = "" Then
        wsThis.Cells(i, "M").Value = "社員番号"
    End If
Next i

' --------------------------
' K列が空白の場合、N列に社員番号補完(C→B部分一致、D→F完全一致)
For i = 5 To lastRowThis
    If wsThis.Cells(i, "K").Value = "" Then
        foundFlag = False
        For j = 2 To lastRowSrc
            bVal = CStr(wsSrc.Cells(j, "B").Value)
            fVal = CStr(wsSrc.Cells(j, "F").Value)
            
            sD = Replace(CStr(Trim(wsThis.Cells(i, "D").Value)), " ", "")
            sD = Replace(sD, " ", "")
            sI = Replace(fVal, " ", "")
            sI = Replace(sI, " ", "")
            
            If InStr(bVal, CStr(wsThis.Cells(i, "C").Value)) > 0 And sD = sI Then
                wsThis.Cells(i, "N").Value = wsSrc.Cells(j, empCol).Value
                foundFlag = True
                Exit For
            End If
        Next j
    End If
Next i

' --------------------------
' G~K列ロック+フィルター許可(毎回リフレッシュ)
With wsThis
    .Cells.Locked = False
    .Range("G:K").Locked = True
    .Protect Password:="", UserInterfaceOnly:=True, AllowFiltering:=True
    
    ' 4行目 A~P列にオートフィルターを再設定
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A4:P4").AutoFilter
End With

EndProc:
On Error Resume Next
If Not wbSrc Is Nothing Then wbSrc.Close SaveChanges:=False
On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox "チェック完了!"

End Sub

以下のように設定↓

🐱こだわりポイント

  • 従業員リストから表示させるときは不要な文字を削除。(例:○○事業部の事業部を消す)
  • 従業員リストから表示された情報は書き換え不可(実行を押すと最後セルに保護がかかる→でもフィルター機能は有効)
  • 修正後も「実行」ボタンで再度エラーチェック可能
  • 「すべてクリア」ボタンで楽々データ削除
  • 個人情報が含まれる「従業員リスト」は見られないようにパスワード設定。
  • コードの中にパスワードが記載されているため、マクロにもパスワード設定。
  • ついでに「実行②」ボタンで「7桁表示・文字列」の社員番号を自動生成!(参加案内を発信をする時に必要)
    いちいちテキスト関数を使っていたけど、その必要なし!

😿うまくいかなかったポイント

  • 社員番号のところが空白でも検索ができるようにしたかったが、何か文字を入れないと動かない。
  • なんの情報もいれないまま「実行」ボタンを押すと何故か一部の文字が消える。

何回もチャッピーに相談したけどダメでした。

🙀使用する上で最大のポイント(弱点)

常に新しい従業員リストを手に入れて、更新していく必要があること!
元データが古かったら何の意味もない~~

自部署メンバーにツールを使ってもらってみた🙌

使用してもらう前に、一通りの使用方法の説明と、どんな時に使う機会ありそう?と質問してみました。

①実務リーダー S氏(今回の製作はリーダーの要望でもありました)

これで名簿の管理が楽になるね。とりあえず一回目の研修案内を発信するときには必ず使ってもらいたい。間違いも減ると思よ。
この名簿が自動的に研修一覧や参加案内に飛べばベストだよね~~~

②実務メンバー Kさん(畜産研修・住居余暇研修担当)

エラー箇所でどこが間違っているのかが一発で目に見えるのが便利。
今まで時間がなくてチェックが出来ていなかったけどこれならできるかも。
いちいち従業員リストから関数を使って照らし合わせなくてもよくなるのがいいですね!
でも出向者など従業員リストに載っていない方もいるからそこは個別で確認が必要になりますね。
同じ感じで社内資格者を検索できるツールも欲しいかも。

③実務メンバー Mさん(総菜研修担当)

今まで名簿チェックは参加案内のシステムを使ってしていましたが、手間がかかるのでこちらの方が便利。
カナまで出るのがいいですね!参加案内を作るとき調べる手間が省けます。
研修の時にお名前を呼ぶとき間違ったら失礼ですからね。そもそも読めない方もいる…

最後にマクロ(VBA)という武器を手に入れて…

マクロに初挑戦した感想としては、
「え?こんな簡単にできることだったの?Excelを使う全人類知るべきじゃない?!」
と初心者が調子に乗るほど。いや、簡単ではなかったです。結局丸1日くらいかかりました😂
でも初心者でもこんなことが1日でできちゃうのかという衝撃。
ネットで色々見ているとVBAはもう古いというご意見も見られましたが、デジタル初心者の私には画期的すぎた!

皆のFBを聞いて、今回作成したツールを元にあの業務とつなげればもっと便利になるよな、解決課題の1つでもある社内資格者名簿の管理ももっと効率化できるななどイメージがなんとなく湧いてきました。
後は私がツールを使いこなせるかどうかにかかっているけれど😂まずは1つレベルアップした感覚です!

以上、マクロ初チャレンジ話でした。お読みいただきありがとうございました🙌

6
3
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
6
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?