Home
Blog
Inquire

VBA

VBA--- エクセル:特定のフォルダ内のエクセルで作成した請求書等のデータを取得し、集計表を作成


 請求書をエクセルで作成(得意先ごとに複数シートで作成した場合)したものを、1つのエクセルブックのシートに集計表を作成(説明は省略)

 Sub Syukei()
  Dim int_fld,out_fld,out_fl As String
  Dim wb,fs,gfld,wb1 As Object
  Dim orowcnt,endrowcnt As Long
  in_fld_obj = "C:\請求書"
  out_fld = "C:\出力先"
  out_fl = "売上集計表.xlsx"
  For Each wb In Workbooks
   If wb.Name = out_fl Then wb.Close
  Next wb
  Set fs = CreateObject("Scripting.FileSystemObject")
  If fs.FileExists(out_fld & "\" & out_fl) = False Then
   Set wb = Workbooks.Add
   wb.SaveAs out_fld & "\" & out_fl
   wb.WorkSheets(1).Name = "集計表"
  Else
   Kill out_fld & "\" & out_fl
   Set wb = Workbooks.Add
   wb.SaveAs out_fld & "\" & out_fl
   wb.Worksheets(1).Name = "集計表"
  End If
  With wb.Worksheets("集計表")
   .Range("A1") = "得意先"
   .Range("B1") = "請求日"
   .Range("C1") = "請求金額"
   .Range("D1") = "ファイル更新日"
   .Range("E1") = "ファイル名"
   .Range("F1") = "シート名"
   Set gfld = fs.GetFolder(in_fld)
   orowcnt = 2
   For Each vBk  In gfld.Files
        If Left(vBk, 2) <> "~$" And InStr(Right(vBk, Len(vBk) - InStrRev(vBk, ".")), "xl") > 0 Then
     Set wb1 = Workbooks.Open(vBk.Path)
     For Each ws In wb1
      If ws.Range("G3") = "請求書" Then
       wb.Range("A" & orowcnt) = ws.Range("A5")
       wb.Range("B" & orowcnt) = ws.Range("M4")
       wb.Range("C" & orowcnt) = ws.Range("C7")
       wb.Range("D" & orowcnt) = vBk.DateLastModified
       wb.Range("E" & orowcnt) = vBk.Name
       wb.Range("F" & orowcnt) = ws.Name
       orowcnt = orowcnt + 1
      End If
     Next ws
    End If
    wb1.Close savechanges:=False
   Next vBk
   Set fs = nothing
   endrowcnt = wb.WorkSheets("集計表").Range("A" & Cells.Rows.Count).End(xlUp).Row
   wb.WorkSheets("集計表").Range("A1:F" & endrowcnt).Borders.LineStyle = xlContinuous
   wb.WorkSheets("集計表").Range("A1:F" & endrowcnt).Borders.Weight = xlThin
   wb.WorkSheets("集計表").Range("A1:F" & endrowcnt).Borders.Color = RGB(166,166,166)
   wb.Activate
   ActiveSheet.Range("B2").Select
   ActiveWindow.FreezePanes = True
   wb.Save
   Set wb = Nothing
   MsgBox "End!"
  End With
 End Sub
    
   


©2018KanazawaNoSakai