Excel（VBA)で経費精算のツール作成を行っております。 マクロ初心者のため、作成に非常に困っております。 要求等多いですが、お力添えいただければと思います。 （同じ題名で投稿したが写真が見えるか不安なので、構文を張り付けたものを再度投稿します） （長文になりすみません） （目的） 社内で社員全員から交通費精算書と経費精算書のExcelファイルを一つのフォルダに入れて、マクロのボタンを押すことで、それぞれ、交通費のシートに転記・経費のシートに転記する仕組みを作りたいと考えております。また、社員番号と社員の氏名だけは別のシートに作ったマスタから抽出するような仕組みを作りたいと考えております。 （現状できたところ） ネットの情報などをコピーしながらメイン画面から、【交通費のボタン】【経費のボタン】を押すことでそれぞれシートに転記することができました。（作成マクロは添付します） （課題・行いたいこと） ・シート名やブック名などをパスで指定しているため社員の方がいじったり、間違えた場合エラーが表示されてしまう。 ・ブック内にsampleのデータが入ってしまうと集計結果に支障を出してしまう ・それぞれボタンを押さないといけない。（できれば一つにまとめたい） ・交通費のシートと経費のシートにわけないとその後の動作が順調にいかない状況が生じる。 →一つのマクロのボタンでシート名やブック名に左右されず、集計できるようににし交通費は交通費のシートに記入・経費は経費のシートに記入するようにしたいです。また、社員番号・氏名は現在作成マクロからとってくるようにようにしたいです。 また、シート内にsampleと書かれたシートがある場合は転記から除外するなどの条件も付けられたら尚嬉しく思います。 可能であれば、マクロが上記の要求を満たした動きをする、 変更した文を教えていただければと思います。 ご要望が多いのは重々承知です、よろしくお願いいたします。 アドバイスがいただきやすいよう、 マクロの構文が作りやすいように現状の構文を画像で載せたいと思います。 見にくい部分もあるかと思いますが何卒、よろしくお願いいたします。 ＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿ 【現状のマクロの文】 ＊交通費精算書のマクロです。経費精算書は形式は下記と同じです。書き込み名や書き込む項目数が異なるだけです。（すみません字数制限により経費は載せられませんでした。） Sub データ取込メイン() Dim sheetobj As Worksheet Dim FolderPath As String Dim 年月 As String Dim ret As Integer '(1)---------------------------------------- '集計表シートクリア プロシージャの呼び出し Call 集計表シートクリア '---------------------------------------- '(2)---------------------------------------- 'フォルダPathと年月の取得 Set sheetobj = ThisWorkbook.Worksheets("メイン画面") With sheetobj FolderPath = .Cells(2, 3) 年月 = .Cells(4, 3) End With '(3)---------------------------------------- 'フォルダPathと年月が入力されているか確認 If FolderPath = "" Then ret = MsgBox("フォルダPathを入力してください", vbCritical) Exit Sub End If If 年月 = "" Then ret = MsgBox("年月を入力してください", vbCritical) Exit Sub End If '(4)---------------------------------------- 'ファイルOpen プロシージャの呼び出し Call ファイルOpen(FolderPath, 年月) '---------------------------------------- '(5)---------------------------------------- '集計表シートを表示する ThisWorkbook.Worksheets("TE集計表").Activate End Sub Sub 集計表シートクリア() Dim salessheet As Worksheet Set salessheet = ThisWorkbook.Worksheets("TE集計表") With salessheet '(1)---------------------------------------- 'すべてのセルの値を消す .Cells.ClearContents '(2)---------------------------------------- '1行目にタイトルを記入 .Cells(1, 1) = "社員コード" .Cells(1, 2) = "氏名" .Cells(1, 3) = "日付" .Cells(1, 4) = "出発" .Cells(1, 5) = "到着" .Cells(1, 6) = "種別" .Cells(1, 7) = "目的" .Cells(1, 8) = "補助科目" .Cells(1, 9) = "負担先" .Cells(1, 10) = "往復片道" .Cells(1, 11) = "金額" .Cells(1, 12) = "小計" '---------------------------------------- End With End Sub Sub ファイルOpen(FolderPath As String, 年月 As String) Dim bookobj As Workbook Dim sheetobj As Worksheet Dim i As Integer Dim FilePath As String Dim 氏名 As String Dim 社員コード As String Set sheetobj = ThisWorkbook.Worksheets("社員マスタ") With sheetobj '(1)---------------------------------------- '社員コードと氏名を順番に取得 For i = 2 To LastRow(sheetobj, 1) 社員コード = .Cells(i, 1) 氏名 = .Cells(i, 2) '(2)---------------------------------------- 'FolderPathにファイル名を連結 FilePath = FolderPath & "\" & 年月 & 氏名 & ".xlsx" '(3)---------------------------------------- 'ワークブックを開いて、bookobjに代入 Set bookobj = Workbooks.Open(FilePath) '(4)---------------------------------------- 'データ転記プロシージャに販売実績シートと社員の氏名を渡す Call データ転記(bookobj.Worksheets(年月), 社員コード, 氏名) '(5)---------------------------------------- '社員のワークブックを閉じます。 bookobj.Close Next i End With End Sub Sub データ転記(datasheet As Worksheet, 社員コード As String, 氏名 As String) Dim salessheet As Worksheet Dim 基準行 As Long Dim 日付 As Date Dim 出発 As String Dim 到着 As Str
↧