【エクセルVBA入門】データの重複を防ぐSubプロシージャの作成

複製

みなさん、こんにちは!
このところひたすらVBAと戯れていますタカハシ(@ntakahashi0505)です。

エクセルVBAを使ってバラバラの経費精算書データを集約するシリーズもいよいよ今回で8回目です。

前回はこちらの記事で

【エクセルVBA入門】マクロでVLookupメソッドを使ってデータを検索する方法
エクセルVBAを使ってバラバラの経費精算書データを集約するシリーズの7回目です。今回は、業務で有効なテクニックとしてもう一つ、マスタシートからVLookupメソッドでデータを取得してくる方法についてお伝えしていきます。

メンバーが入力ミスをしている経費精算書でも、ファイル名とマスタを使って正しくデータを蓄積する対策についてお伝えしました。

今回は、一連のシリーズの最終回重複チェックとデータの上書きの機能について追加をしていきたいと思います。

よろしくお願いします!

スポンサーリンク

前回までのおさらいと今回の課題

前回完成したプログラムがこちらです。

Sub 経費精算データ取り込み()

Dim i As Long, j As Long 'カウント用変数

Dim wsData As Worksheet '「経費データ」シートを入れるオブジェクト変数
Set wsData = ThisWorkbook.Worksheets("経費データ")

Dim wsStaff As Worksheet '「社員マスタ」シートを入れるオブジェクト変数
Set wsStaff = ThisWorkbook.Worksheets("社員マスタ")

j = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1

'ファイルパスの取得
Dim strPath As String
strPath = ThisWorkbook.Path & "\data\"

'ファイルシステムオブジェクト変数の準備
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")  'FileSystemObject

Dim objFile As Object 'ファイルを格納するオブジェクト変数

For Each objFile In objFSO.getfolder(strPath).Files

    With Workbooks.Open(Filename:=strPath & objFile.Name, ReadOnly:=True)
        
        With .Worksheets(1)
            
            'ファイル名から年月を取得
            Dim strPeriod As String
            strPeriod = Left(objFile.Name, 6)
            
            'ファイル名から社員番号を取得
            Dim numStaff As Long
            numStaff = Val(Right(Replace(objFile.Name, ".xlsx", ""), 4))
            
            i = 0
            
            Do While .Cells(12 + i, 1).Value <> ""  '繰り返し条件文
                wsData.Cells(j, 1).Value = DateSerial(Left(strPeriod, 4), Right(strPeriod, 2), 1) '1 対象月
                wsData.Cells(j, 2).Value = .Cells(12 + i, 1).Value    '2 日付
                wsData.Cells(j, 3).Value = WorksheetFunction.VLookup(numStaff, wsStaff.Range("A:D"), 3, False) '3 部署No
                wsData.Cells(j, 4).Value = WorksheetFunction.VLookup(numStaff, wsStaff.Range("A:D"), 4, False) '4 部署
                wsData.Cells(j, 5).Value = numStaff                                                            '5 社員No
                wsData.Cells(j, 6).Value = WorksheetFunction.VLookup(numStaff, wsStaff.Range("A:D"), 2, False) '6 氏名
                wsData.Cells(j, 7).Value = .Cells(12 + i, 2).Value    '7 科目
                wsData.Cells(j, 8).Value = .Cells(12 + i, 5).Value    '8 摘要
                wsData.Cells(j, 9).Value = .Cells(12 + i, 6).Value    '9 金額
                wsData.Cells(j, 10).Value = .Cells(12 + i, 7).Value   '10 備考
                
                i = i + 1
                j = j + 1
                
            Loop
        End With
        
        .Close SaveChanges:=False
    
    End With
    
Next objFile

End Sub

各メンバーから受け取った経費精算書について、以下図のように「経費データ」シートに蓄積をしていきます。

経費精算書のデータの収集結果

前回は

  • ファイル名objFile.Nameから、Val,Right,Replaceを使って社員番号を抜き出す
  • それをキーにしてWorksheetFunction.VLookupにて社員マスタから部署名、社員の氏名を取得

というお話でした。

今回ですが、例えば同じファイルを誤って複数回取り込んでしまったらどうなるか?ということなのですが、実際にやってみると

経費データが重複して登録されてしまう

このように、重複してどんどんデータが追加されてしまいます。これは危険ですね…。

これを防ぐために、既に同じ対象月の同じ社員のデータが入っていた場合は、それをまず削除してしまうという処理を追加したいと思います。

既にある重複データを削除する処理の追加方針

まず考え方をまとめてみましょう。

削除すべきデータを削除する処理は、対象月と社員番号がわかってからですから、

'ファイル名から年月を取得
Dim strPeriod As String
strPeriod = Left(objFile.Name, 6)

'ファイル名から社員番号を取得
Dim numStaff As Long
numStaff = Val(Right(Replace(objFile.Name, ".xlsx", ""), 4))

この後に入れる形になります。

削除の処理は「重複削除」という名前でSubプロシージャを用意して、そのプロシージャに対象月と社員番号を渡して処理をしてもらうということにしましょう。

また、「経費データ」シートの何行目か?をつかさどるカウント変数jですが

j = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1

今はプログラムの冒頭に実行するようになっていますが、行の削除をした場合は行数が変更になりますから、重複削除プロシージャの後に場所移動します。

さらに、Worksheetオブジェクトの宣言ですが

Dim wsData As Worksheet '「経費データ」シートを入れるオブジェクト変数

は重複削除プロシージャでも使うので、プロシージャの外に出してPublic宣言をします。

Subプロシージャの呼び出しとPublic変数についてはこちらの記事も合わせてご覧ください。

301 Moved Permanently

Dim変数を渡す場合のCallによるプロシージャ呼び出し

プロシージャ内でDim宣言した変数は宣言したプロシージャ内でしか使えないので、他のプロシージャでも使いたい場合は変数を渡す必要があります。

このように書きます。

Call プロシージャ名(変数1,変数2,…)

今回の場合は対象月と社員番号を渡しますが、strPeriodは6桁の文字列型でDate型ではありませんので、対象月を表すDate型に変換してあげる必要がありますね。

'年月をdate型対象月に変換
Dim datePeriod As Date
datePeriod = DateSerial(Left(strPeriod, 4), Right(strPeriod, 2), 1)

この上で、対象月datePeriodと社員番号numStaffを重複削除プロシージャに渡せばOKです。

Call 重複削除(datePeriod, numStaff)

重複削除プロシージャ

重複削除プロシージャは、このように書きます。

Sub 重複削除(datePeriod, numStaff)
    
    Dim i As Long 'カウント用変数    
    i = 2
    
    With wsData 
    
        Do While .Cells(i, 1).Value <> ""
    
            If .Cells(i, 1).Value = datePeriod And .Cells(i, 5).Value = numStaff Then
            
                .Rows(i).Delete
            
            Else
            
                i = i + 1
            
            End If
    
        Loop
        
    End With

End Sub

Callで渡された変数の受け取り方ですが、冒頭に

Sub プロシージャ名(変数1,変数2,…)

と書きます。変数名は渡されたときと別の名前にすることができますが、わかりやすさのために同じ名前にしています。

その他の部分の解説ですが、まずDo While~Loopで「経費データ」シートの2行目から最後尾までを順番に見ていきます。

If文ですが、今対象となっている行の対象月がdatePiriodと同じでかつ社員番号がnumStaffと等しければ、その行を削除します。

行の削除はもうご想像できていると思いますが

Rows(行番号).Delete

と書きます。

行の削除をした場合は、下の行たちがシフトして詰められますので、カウント変数iを加算せずにDo While~Loopに入っても問題ありません。

If文の条件式にマッチしていなければ、カウント変数iを加算して次の行に移動します。

これで完成です。

まとめ

同じ経費精算書データを取り込む際のデータ重複を防ぐ重複削除プロシージャを作成しました。

なお、元のデータを削除して新たなデータを追加するわけですから、データに修正を加えたいときにも有効に使えますね。

最後に完成したプログラムを載せておきますね。

Publicでのオブジェクト変数宣言

Option Explicit

Public wsData As Worksheet '「経費データ」シートを入れるオブジェクト変数
Public wsStaff As Worksheet '「社員マスタ」シートを入れるオブジェクト変数

メインプログラム:経費精算データ取り込みプロシージャ

Sub 経費精算データ取り込み()

Dim i As Long, j As Long 'カウント用変数

Set wsData = ThisWorkbook.Worksheets("経費データ")
Set wsStaff = ThisWorkbook.Worksheets("社員マスタ")

'ファイルパスの取得
Dim strPath As String
strPath = ThisWorkbook.Path & "\data\"

'ファイルシステムオブジェクト変数の準備
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")  'FileSystemObject

Dim objFile As Object 'ファイルを格納するオブジェクト変数

For Each objFile In objFSO.getfolder(strPath).Files

    With Workbooks.Open(Filename:=strPath & objFile.Name, ReadOnly:=True)
        
        With .Worksheets(1)
            
            'ファイル名から年月を取得
            Dim strPeriod As String
            strPeriod = Left(objFile.Name, 6)
            
            '年月をdate型対象月に変換
            Dim datePeriod As Date
            datePeriod = DateSerial(Left(strPeriod, 4), Right(strPeriod, 2), 1)
            
            'ファイル名から社員番号を取得
            Dim numStaff As Long
            numStaff = Val(Right(Replace(objFile.Name, ".xlsx", ""), 4))
            
            Call 重複削除(datePeriod, numStaff)
            
            j = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1
            
            i = 0
            
            Do While .Cells(12 + i, 1).Value <> ""  '繰り返し条件文
                wsData.Cells(j, 1).Value = datePeriod                 '1 対象月
                wsData.Cells(j, 2).Value = .Cells(12 + i, 1).Value    '2 日付
                wsData.Cells(j, 3).Value = WorksheetFunction.VLookup(numStaff, wsStaff.Range("A:D"), 3, False) '3 部署No
                wsData.Cells(j, 4).Value = WorksheetFunction.VLookup(numStaff, wsStaff.Range("A:D"), 4, False) '4 部署
                wsData.Cells(j, 5).Value = numStaff                                                            '5 社員No
                wsData.Cells(j, 6).Value = WorksheetFunction.VLookup(numStaff, wsStaff.Range("A:D"), 2, False) '6 氏名
                wsData.Cells(j, 7).Value = .Cells(12 + i, 2).Value    '7 科目
                wsData.Cells(j, 8).Value = .Cells(12 + i, 5).Value    '8 摘要
                wsData.Cells(j, 9).Value = .Cells(12 + i, 6).Value    '9 金額
                wsData.Cells(j, 10).Value = .Cells(12 + i, 7).Value   '10 備考
                
                i = i + 1
                j = j + 1
                
            Loop
        End With
        
        .Close SaveChanges:=False
    
    End With
    
Next objFile

End Sub

重複削除プロシージャ

Sub 重複削除(datePeriod, numStaff)
    
    Debug.Print datePeriod, numStaff
    
    Dim i As Long 'カウント用変数
    
    i = 2
    
    With wsData
    
        Do While .Cells(i, 1).Value <> ""
    
            If .Cells(i, 1).Value = datePeriod And .Cells(i, 5).Value = numStaff Then
            
                .Rows(i).Delete
            
            Else
            
                i = i + 1
            
            End If
    
        Loop
        
    End With

End Sub

ではまた別のシリーズでお会いしましょう!

連載目次:エクセルVBAで経費データをデータベースに集約する

請求書シリーズと逆のパターンですが、バラバラの帳票からデータ一覧つまりデータベースに情報を集めて蓄積していく、というお仕事も多いと思います。ここでは各担当者から提出された経費精算書をデータベースに蓄積するプログラムを目標にして進めていきます。
  1. 【エクセルVBA入門】バラバラの経費精算書をデータにまとめる
  2. 【エクセルVBA入門】Do While~Loop文で条件を満たす間繰り返し
  3. 【エクセルVBA入門】繰り返しを使ってデータの転記をするときの2つのポイント
  4. 【エクセルVBA入門】With文でプログラムをスッキリわかりやすく書く
  5. 【エクセルVBA入門】他のワークブックをWithで開く&保存せずに閉じる
  6. 【エクセルVBA入門】フォルダやファイルを操作するFileSystemオブジェクトとその使い方
  7. 【エクセルVBA入門】For Each~Next文でフォルダ内のブック全てを開く方法
  8. 【エクセルVBA入門】シートのデータがある最終行番号を求めるステートメントを徹底解説
  9. 【エクセルVBA入門】開いたブック名から文字列を抽出して人為的なミスを回避する方法
  10. 【エクセルVBA入門】マクロを作るときに知っておきたいマスタデータのこと
  11. 【エクセルVBA入門】開いたブックのファイル名から番号を取り出して数値に変換する
  12. 【エクセルVBA入門】マクロでVlookupを使ってデータを検索する方法
  13. 【エクセルVBA入門】Vlookupメソッドを使ったときに発生するエラーを回避する方法
  14. 【エクセルVBA入門】エラーが発生したときに分岐処理を追加する方法
  15. 【エクセルVBA入門】オートフィルタや行の非表示で隠れている行を全て表示する
タイトルとURLをコピーしました