月ごとにある給与データファイルを読み込んで加工利用したいです。

Question

ＶＢＡ初心者ですが、こんなことがしたいです。
某給与ソフトデータが月ごとにあります。
ＣＳＶファイルですが将来の拡張の為一旦ＥＸＣＥＬ形式にしたほうが安全かなとも思います。

その中から

　　Ａ　　　　　Ｂ　　　Ｃ　　　　Ｄ　　　　Ｅ　　　Ｆ
１　社員番号　氏名　項目Ｃ　項目Ｄ　項目Ｅ　合計
２　1121　　　熊　　　　　　　　　　20　　　1000
３　1122　　　猿
４
・
・

例えば４月分；社員番号に一致するデータのうち、必要な項目のみ選別し（あるいはコピー）、Ｆ-Ｅのような加工処理をして、加工集約シート上のその月のセルに記入される。

加工集約シート
　　Ａ　　　　　Ｂ　　　　Ｃ　　　　　　　　　Ｅ　　　
　　　　　　　　　　４月分　　　　　５月分
１　社員番号　氏名　合計Ｆ－項目Ｅ　合計Ｆ－項目Ｅ
２　1121　　　熊　　980
３　1122　　　猿　　　　　　　　　　
４　
・
・


他に集約シートに無い中途採用人員は自動的に作成して欲しいのですが、まそれはまた別の機会にお尋ねしたほうが（私の頭がついてゆかない）よさそうです。

まずは起動時に何月分のデータを読み込むか指定して（各月の上に専用ボタンを作るのが簡単でしょうか？）、読み込む対象ファイルを指定（あるいは集約シートのあるブックにあらかじめ別シートとしてコピーしておく）。　社員番号をみて合致する行があればその月の列に、所定の計算をしたうえで記入。これをデータがなくなるまで繰り返す。

これを実行する記述は出来るでしょうか？
もろズバリでも参考サイトでも良いですので教えてください。

Wendy02 · Accepted Answer

私の考えたマクロ:

集約ファイル(Book)は、Excel標準形式にします。(マクロを置きますから）
読み込む対象:CSV ファイルを選択するところから始めます。
月数は、マニュアルで入力します。例: 4

集約ファイル(Book)に社員番号がないと、自動的に社員番号と名前を記入します。
月々のデータの社員番号にダブりがある場合は、集計せずに、メッセージを出して終了します。チェック機能がいらなければ、取り外しが可能です。

集約ファイル(Book)の順番と、月々のデータの並びが一致しなくても、書き込みします。

フォームやコントロールツールのボタンを1つ設けて、そこに登録すればよいと思います。

Option Explicit
Dim myData() As Variant
Sub ShukeiPrc()
　Dim ShainNo() As Variant
　Dim ans As String
　Dim Rng As Range, c As Range
　Dim i As Long, j As Long, k As Long
　Dim ErrChk() As Variant
　Dim Chker As Boolean
　Dim MonthNo As Integer
　Dim MonthDataSheet As Worksheet
　Dim myFName As String
　　myFName = Application.GetOpenFilename("CSV ファイル(*.csv),*.csv", , "ファイル選択")
　If myFName = "False" Then
　　'キャンセルの場合
　　Exit Sub
　End If
　On Error GoTo ErrHandler
　With Workbooks.Open(myFName)
　　ans = Application.InputBox("月数を入れてください。例: " & Month(Date), Type:=2)
　　If ans = "False" Or ans = "" Then
　　　GoTo Quit
　　ElseIf CInt(ans) < 1 Or CInt(ans) > 12 Then
　　　MsgBox "入力した月数が間違っています。(1-12)", 16
　　　GoTo Quit
　　　Else
　　　MonthNo = CInt(ans)
　　End If
　　With ActiveSheet
　　　Set Rng = .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
　　　If Rng.Count = 1 Then MsgBox "データを確かめてください。", 64: Exit Sub
　　　For Each c In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
　　　　ReDim Preserve ShainNo(i)
　　　　ShainNo(i) = c.Value
　　　　i = i + 1
　　　Next c
　　　'ダブりのチェック
　　　doublingChecker ShainNo, ErrChk, Chker
　　　If Chker Then
　　　　MsgBox "社員番号に重複があります。訂正してください。", 16
　　　　GoTo Quit
　　　End If
　　　'ダブりのチェック終了
　　　For j = LBound(ShainNo) To UBound(ShainNo)
　　　　ReDim Preserve myData(2, j)
　　　　myData(0, j) = ShainNo(j)
　　　　'2行目からなので、+2
　　　　myData(1, k) = .Cells(j + 2, "F").Value - .Cells(j + 2, "E").Value
　　　　'名前の確保
　　　　myData(2, k) = .Cells(j + 2, "B").Value
　　　　k = k + 1
　　　Next j
　　End With
Quit:
　　　'終りの手続き
　　　Set Rng = Nothing: Erase ShainNo
　　 .Close SaveChanges:=True
　End With
　Set MonthDataSheet = Nothing
　'次の処理へ
　Call DataPaste(myData, MonthNo)
ErrHandler:
　If Err.Number > 0 Then
　　MsgBox Err.Description
　Else
　Beep '正常終了の場合
　End If
End Sub
Private Function doublingChecker(ByVal BaseArray As Variant, _
　　　　　　　　　　　　 ErrStock(), _
　　　　　　　　　　　　 flg)
　Dim rtn As Variant
　Dim i As Long, k As Long
　For i = LBound(BaseArray) To UBound(BaseArray)
　　If Not IsEmpty(BaseArray(i)) Then
　　　rtn = Application.Match(BaseArray(i), BaseArray, 0) - 1
　　　If Not IsError(rtn) Then
　　　　If rtn <> i Then
　　　　　ReDim Preserve ErrStock(k)
　　　　　ErrStock(k) = i
　　　　　flg = True
　　　　　k = k + 1
　　　　End If
　　　End If
　　End If
　Next i
End Function
Private Sub DataPaste(BaseArray As Variant, _
　　　　　　　　　　　MonthNo As Integer)
　Dim ShuKeiSheet As Worksheet
　Dim Rng As Range
　Dim rtn As Variant
　Dim LastRow As Long, i As Long
　Set ShuKeiSheet = Sheet1 '※集約シートを書いてください。
　'データは、3列目から
　If MonthNo > 3 Then MonthNo = MonthNo - 1 Else MonthNo = MonthNo + 11
　With ShuKeiSheet
　　.Activate
　　'Rngの範囲は変更しないこと
　　Set Rng = .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
　　If Rng.Rows.Count = 1 Then
　　　LastRow = 3 '何も書かれていない場合は、3行目から
　　Else
　　　　LastRow = Rng.Rows.Count + 1
　　End If
　　For i = LBound(BaseArray, 2) To UBound(BaseArray, 2)
　　　'社員番号探し
　　　rtn = Application.Match(BaseArray(0, i), Rng, 0)
　　　If Not IsError(rtn) Then
　　　　'通常の転記
　　　　.Cells(rtn, MonthNo).Value = BaseArray(1, i)　'集計
　　　　Else
　　　　 '社員番号がない時
　　　　.Cells(LastRow, "A").Value = BaseArray(0, i) '社員番号
　　　　.Cells(LastRow, MonthNo).Value = BaseArray(1, i) '集計
　　　　.Cells(LastRow, "B").Value = BaseArray(2, i) '名前
　　　　LastRow = LastRow + 1
　　　End If
　　Next i
　End With
　Set ShuKeiSheet = Nothing
End Sub

Wendy02 · Answer

こんにちは、oyajidayoさん。＞早速動作確認いたしました。完璧です。それは良かったでした。＞本来自分で勉強すべきですが、今のお仕事優先ですから、それは、仕方がないです。記録マクロではなく、簡単なマクロを書けるようになれば、それで十分だと、私個人は思っています。＞お恥ずかしい話、賞与については１３月.１４月にでも定義気が付かなくてすみません。それは、直します。現在では、13、14月では、マクロが終了してしまいます。＞変更・追加の項目・作業が出てきますがまだ、細かい点で不備な点があると思います。トラブルや変更などの際には、常に常連が書いている中規模程度のExcelVBA専用の掲示板でお尋ねになったほうが、スムーズな話の展開でサポートが得られるかと思います。私の場合、書き込みできない時があります。コードのレベルとしては、初級を終えた段階で処理できる内容です。ただ、内容は、わたし的だと思いますが、Excel専用のVBAでは、あまり、こういう配列に一旦確保してやる方法は使われません。理由は、Excelの複数のセルに対して使うと、コードが読みにくくなるからです。 VBE のコードペイン（白い画面）をアクティブにしたら、メニューの編集－検索（双眼鏡アイコンツール）で、例えば　CInt(ans) とでも入れて、探してみてください。 ------------------------------------------------ Sub ShukeiPrc() ・・前: ElseIf CInt(ans) < 1 Or CInt(ans) > 12 Then 修正後: ElseIf CInt(ans) < 1 Or CInt(ans) > 14 Then ------------------------------------------------ 前:<ここは、私のミスです> '次の処理へ　Call DataPaste(myData, MonthNo) ErrHandler: 　If Err.Number > 0 Then 　　MsgBox Err.Description 　Else 　Beep '正常終了の場合　End If '修正後 ErrHandler: 　If Err.Number > 0 Then 　　MsgBox Err.Description 　Else 　 '次の処理へ　Call DataPaste(myData, MonthNo) 　Beep '正常終了の場合　End If End Sub ------------------------------------------------ 以下の行で、列を決めています。 Private Sub DataPaste(BaseArray As Variant, _ 　　　　　　　　　　　MonthNo As Integer) ・前 'データは、3列目から If MonthNo > 3 Then MonthNo = MonthNo - 1 Else MonthNo = MonthNo + 11 ([4]月を入れれば、4-1 =3 列目, [1]月を入れると、1+11 = 12列目ですから、 '修正後 'データは、3列目から　　If MonthNo > 3 And MonthNo < 13 Then 　　 MonthNo = MonthNo - 1 　ElseIf MonthNo < 4 Then 　　 MonthNo = MonthNo + 11 　Else 　　 MonthNo = MonthNo + 2 　End If

月ごとにある給与データファイルを読み込んで加工利用したいです。

私の考えたマクロ:

こんにちは、oyajidayoさん。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング