次の出金伝票を見てください。
これが標準の記入方法で記入されたものです。
セルA7からC10の範囲に入力されています。
これは、1行空けて記入しています。
これの処理を自動化すると、A7からA10の中のデータ個数を見て、その中に入力されているデータ個数で７行目から何行コピーするか考えるのですが、空白行が間に入ることでコピーする範囲が違ってきてしまいます。
１行しかデータがない場合は、いらない行を削除してしまうかもしれません。
もしくは、データが４行では収まらないケースもあるかもしれません。
これは実際にあり得ますね。
勝手に備考欄を追加され、行番号が変わってしまうケースもあるかもしれません。
以上の例のように、どんなふうに入力してほしいか伝えておかないと、自動化できないものが量産されてしまいます。
それに気付いて、その時に入力規則やセルの保護をしたり、方法を統一するよう指導したりしても、その時にはすでに大量にルール違反の伝票が多く出来てしまっています。
そこで、上記のケースに対応できる、データをまとめるVBAを作りました。
ルールは、データの範囲はA列の「摘要」の次の行から「合計」の前の行までのA列からC列まで。
その他、記録するデータは、A列に「日付」「担当者」「コード」「支払先」と書いてあるB列とします。
取り込みするファイル一覧は、データを取りまとめするブックのA列に次のように記録されているものとします。
これは、この記事にあるFunctionで作ることができます。
データを取りまとめするブックでマクロを起動します。
元データの範囲を並べ替えることで、空白行にも対応します。
処理したファイルは別フォルダに移動しておかないと、またまとめる対象になり、データが２重になりますので、適宜、移動またはファイル名の変更をします。
処理後は次のような仕上がりになります。
Dim FileName As String
Dim MyWB As Workbook
Dim MyWS As Worksheet
Dim WorkWB As Workbook
Dim WorkWS As Worksheet
Dim WorkArea As Range
Dim i As Integer
Dim StartRow As Integer
Dim EndRow As Integer
Dim DataCount As Integer
Dim DataSetTop As IntegerSet MyWB = ActiveWorkbook
Set MyWS = ActiveSheetFolderName = MyWS.Range(“A1”).Value
i = 2
Do While MyWS.Range(“A” & i).Value <> “”
FileName = MyWS.Range(“A” & i).Value
Workbooks.Open FolderName & “\” & FileName
Set WorkWB = ActiveWorkbook
Set WorkWS = ActiveSheet
StartRow = WorksheetFunction.Match(“摘要”, WorkWS.Range(“A:A”), 0) + 1
EndRow = WorksheetFunction.Match(“合計”, WorkWS.Range(“A:A”), 0) – 1
Set WorkArea = WorkWS.Range(“A” & StartRow & “:C” & EndRow)
Call WorkArea.Sort(WorkWS.Range(“A” & StartRow))
DataCount = WorksheetFunction.CountA(WorkWS.Range(“A” & StartRow & “:A” & EndRow))
Set WorkArea = WorkWS.Range(“A” & StartRow & “:C” & DataCount – 1 + StartRow)
DataSetTop = WorksheetFunction.CountA(MyWS.Range(“C:C”)) + 1
MyWS.Range(“C” & DataSetTop & “:C” & DataSetTop + DataCount – 1).Value = FileName
MyWS.Range(“D” & DataSetTop & “:D” & DataSetTop + DataCount – 1).Value = WorksheetFunction.VLookup(“日付”, WorkWS.Range(“A:C”), 2, False)
MyWS.Range(“E” & DataSetTop & “:E” & DataSetTop + DataCount – 1).Value = WorksheetFunction.VLookup(“担当者”, WorkWS.Range(“A:C”), 2, False)
MyWS.Range(“F” & DataSetTop & “:F” & DataSetTop + DataCount – 1).Value = WorksheetFunction.VLookup(“コード”, WorkWS.Range(“A:C”), 2, False)
MyWS.Range(“G” & DataSetTop & “:G” & DataSetTop + DataCount – 1).Value = WorksheetFunction.VLookup(“入金先”, WorkWS.Range(“A:C”), 2, False)
MyWS.Range(“H” & DataSetTop & “:J” & DataSetTop + DataCount – 1).Value = WorkArea.Value
WorkWB.Close
‘//対象ファイルを処理済みフォルダに移動する場合は次の処理をする
‘Name FolderName & “\” & FileName As FolderName & “\処理済み\” & FileName
i = i + 1
Loop
MsgBox (i – 1 & “個のファイルをまとめました”)
End Sub
コメント