今回は経理のお仕事の業務効率化です。
「請求金額の一覧表と、ダウンロードしてきたCSV形式の入金金額一覧表はあるんだけど、請求した金額がちゃんと振り込まれてるかのチェックが大変なんです(><; 」
というご依頼をいただきました。
ちなみに私、こういう仕事をアナログでやってたことがあります。このご時世なのに超アナログで（笑）
帳簿も全部手書きでやってたし（それをPDFにして税理士さんに送ってた）、入金管理は通帳に記帳した文字列と帳簿でにらめっこです。
まぁ、そんなに売掛のお客さん多くなかったからそれほど大変ではなかったんだけど(^^;
今回依頼してくれたお客さんの入金データ見せてもらったのですが、
うわぁ。。。
って思うくらいめんどくさそうでした。
取引先がたくさんあって
請求が月に何度かあるから同じ会社から何度か振り込まれて
同じ会社なのに使い道による違いなのか複数の振込名に分かれてて
うわぁ。。。
というわけで、少しでも依頼者さんの負担を軽くすべく頑張りました！
請求金額の一覧と入金金額の一覧はエクセルの形式であるとのことなので、両者をそれぞれのシートにペタッと貼ってもらって
あとはボタンを押すだけ！
こんな感じの入金データと請求データがありまして、
こんな風に
請求データに対してちゃんと振り込まれてるか
を1つのシートの中で見比べられるようになりました。
そのままコピペしたら動くコードを貼っておきます。
ただ、請求金額一覧とか、入金データとかは各会社によって書式が変わってくるから実際に使うには適宜変更が必要になるのですが。。。
Option Explicit
Sub AnalyzeData()
''''''''''''''''''''変数'''''''''''''''''''''''
Dim i As Long, j As Long, k As Long
Dim LastRowNum As Long, LastRownumResult As Long
Dim RowNum As Long
Dim tmpStr As String, tmpNum As Long
Dim Total As String, Bunkatsu As String, tmp As String, tmp2 As String
'''''''''''''''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = False
''''''''''''照合結果シートを初期化。１行目を残して削除して、J列にOKかNGかを入れるための関数を入力
Sheets("照合結果").Activate
'照合結果シートのデータを削除
Range("B2:J1000").Clear
'照合結果のところに関数を追加
For i = 2 To 1000
Cells(i, 10) = "=IF(OR(I" & i & "="""",E" & i & "=""""),"""",IF(E" & i & "=I" & i & ",""OK"",""NG""))"
Next i
'''''''''''''入金データシートの振込名から会社を特定する
Sheets("入金データ").Activate
Columns(4).Clear
Columns(5).Clear
Columns(6).Clear
Range("D1") = "会社名"
Range("E1") = "顧客ID"
'変換表から該当するものを探す
LastRowNum = Cells(Rows.Count, 3).End(xlUp).Row
For i = 2 To LastRowNum
'会社名が入力されてたら実行
If Len(Cells(i, 3)) > 0 Then
RowNum = ReturnRowNum("変換表", Cells(i, 3), 3)
'振込名が見つからなかった場合はRowNumが0になるのでその時は実行しない
If RowNum > 0 Then
Cells(i, 4) = Sheets("変換表").Cells(RowNum, 2)
Cells(i, 5) = Sheets("変換表").Cells(RowNum, 1)
End If
End If
Next i
'照合結果２シートに入金データシートの値を丸っとコピー
Sheets("入金データ").Cells.Copy
With Sheets("照合結果２")
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues '値貼り付け
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats '書式貼り付け
.Columns(3).Insert
.Cells(1, 3) = "照合済"
End With
'''''''''''''請求データを照合結果に転記
Sheets("照合結果").Activate
'請求データを照合結果に転記
With Sheets("請求データ")
LastRowNum = .Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To LastRowNum
'分割かどうか判断
If InStr(.Cells(i, 1), "分割") > 0 Or .Cells(i, 1) = "" Then
Cells(i - 1, 6) = .Cells(i, 2)
Else
Cells(i, 3) = .Cells(i, 1)
Cells(i, 4) = .Cells(i, 2)
Cells(i, 5) = .Cells(i, 3)
End If
Next i
End With
'空白行を削除
For i = 2 To LastRowNum
If Cells(i, 3) = "" Then
Rows(i).Delete
End If
Next i
'''''''''''''''入金データシートのデータを照合結果シートへ転記
With Sheets("照合結果")
Sheets("入金データ").Activate
LastRowNum = Cells(Rows.Count, 3).End(xlUp).Row
LastRownumResult = .Cells(Rows.Count, 3).End(xlUp).Row
'該当するものを探す 無ければ照合結果シートの一番下に会社名を足す
For i = 2 To LastRowNum
'会社名が入って入れば実行
If Cells(i, 4) <> "" Then
RowNum = ReturnRowNum("照合結果", Cells(i, 4), 4)
If RowNum = 0 Then
.Cells(LastRownumResult + 4, 4) = Cells(i, 4)
.Cells(LastRownumResult + 4, 3) = Cells(i, 5)
LastRownumResult = LastRownumResult + 1
End If
End If
Next i
LastRownumResult = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 2 To LastRownumResult
tmp = ""
tmp2 = ""
For j = 2 To LastRowNum
'会社名が一致すれば実行
If Cells(j, 4) = .Cells(i, 4) Then
'入金額をtmp2に代入
tmp2 = Cells(j, 2)
'tmpに既に数字が入っていれば
If Len(tmp) > 0 Then
tmp = tmp & "+" & tmp2
Else
tmp = tmp2
End If
'合計金額もしくは分割の数字と一致してたら照合結果２シートにチェックを入れる
If InStr(.Cells(i, 6), tmp2) > 0 Then
Sheets("照合結果２").Cells(j, 3) = "〇"
ElseIf InStr(.Cells(i, 5), tmp2) > 0 Then
Sheets("照合結果２").Cells(j, 3) = "〇"
End If
End If
Next j
If Len(tmp) <> 0 And Len(.Cells(i, 4)) > 0 Then
.Cells(i, 8) = tmp
.Cells(i, 9) = "=" & tmp
End If
Next i
End With
Application.ScreenUpdating = True
'結果を見やすいように照合結果シートを開く
Sheets("照合結果").Activate
End Sub
Function ReturnRowNum(SheetName As String, Koumoku As String, ColNum As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'シート名と項目名を受け取り行番号を返す関数
'Function ReturnRowNum(シート名、項目名、探す行番号)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i As Long, LastRowNum As Long
LastRowNum = Sheets(SheetName).Cells(Rows.Count, ColNum).End(xlUp).Row
For i = 2 To LastRowNum 'リストの下端までが検索対象
If Sheets(SheetName).Cells(i, ColNum) = Koumoku Then
ReturnRowNum = i
Exit For
End If
Next i
End Function
何がどうなって動いてるのか、人のコードは読みづらいと思うので動画で説明してみました。
動画で見て内容を理解したら、自分が使う用にカスタマイズできるかと思います！
これで毎月発生する作業が時短できたら、かなりの負担削減になるはず。
コンピューターが得意な繰り返し作業はコンピューターに任せて、自分にしかできない仕事をしてほしい。
もしくは残業時間を減らして、自分にとって有意義なことに時間を使ってほしい！
そんな思いがあるので、この記事が少しでもどなたかのお役に立てると嬉しいです。
コメント