class UserForm1
    Option Explicit

    Private Sub btnBillDir_Click()
        Me.txtBillDir.Text = GetFolder()
    End Sub
        
    Private Sub btnCiam_Click()
        Dim fileNameObj
        fileNameObj = Excel.Application.GetOpenFilename("Excel文件(*.xlsx),*.xlsx")
        If fileNameObj <> False Then
            Me.txtCiam.Text = fileNameObj
        End If
        
    End Sub
    
    Private Sub CommandButton2_Click()
        If Me.txtBillDir.Text <> "" And Me.txtCiam.Text <> "" And Me.txtZq.Text <> "" Then
            Me.Hide
            Execute Me.txtBillDir, Me.txtCiam.Text, Me.txtZq.Text
            Unload Me
        End If
    End Sub
    
    
    Private Sub UserForm_Initialize()
        Me.txtZq = Format(DateAdd("M", -1, Now()), "yyyyMM")
    End Sub
    
end class

class ALCatelogClass
    Option Explicit

    Private m_sheet As Worksheet
    Private m_Items As Collection
    Private m_fl As String '分类
    
    Public Sub Init(vsheet As Worksheet)
        Set m_sheet = vsheet
        m_fl = vsheet.Name
        Dim i
        Dim mitem As AlCatelogItemClass
        Set m_Items = New Collection
        For i = 2 To vsheet.UsedRange.Rows.Count
            Set mitem = New AlCatelogItemClass
            With mitem
                .Init vsheet, i
            End With
            m_Items.Add mitem
            Set mitem = Nothing
        Next
    End Sub

    '填充ciam金额/复制改名为简称/写入金额
    Sub Fill(destDir, ciamDict, billDict)
        If m_Items Is Nothing Then Exit Sub
        If m_Items.Count = 0 Then Exit Sub
        
        '文件写入到工作簿
        Dim wb As Workbook, summarySht As Worksheet, fileName
        Set wb = Workbooks.Add
        fileName = destDir & "\" & m_fl & ".xlsx"
        wb.SaveAs fileName
        
        '汇总表
        Set summarySht = wb.Sheets(1)
        summarySht.Name = m_fl & "汇总表"
        WriteHeader m_sheet, summarySht
        
        '写ciam金额及金额，复制文件
        Dim element
        For Each element In m_Items
            element.WriteCiamJe ciamDict
            element.WriteBill wb, billDict, m_sheet, summarySht
            'Debug.Print element.jc & "/" & element.yjzh
        Next
        
        '汇总表合计及格式
        summarySht.Activate
        SetSummaryStyle summarySht
        
        wb.Save
        '保存工作簿
        wb.Close
        
    End Sub

    '写表头
    Private Sub WriteHeader(pSht As Worksheet, curSht As Worksheet)
        Dim rng As Range
        Set rng = pSht.Range("B1,C1,D1,E1,F1,I1")
        rng.Copy curSht.Range("A1")
        Set rng = Nothing
        
    End Sub

    Private Sub SetSummaryStyle(sht As Worksheet)
        Dim max, rng As Range
        max = sht.Cells(sht.Cells.Rows.Count, "A").End(xlUp).Row
        Set rng = sht.Cells(max + 1, "E")
        rng.value = "合计"
        rng.HorizontalAlignment = xlHAlignCenter
        rng.Offset(0, 1).Formula = "=SUM(F2:F" & max & ")"
        sht.UsedRange.EntireColumn.AutoFit
        With sht.Range(sht.Cells(1, 1), sht.Cells(max + 1, "F"))
            .Borders.LineStyle = xlContinuous
            .Borders.Weight = xlThin
            .Interior.Color = RGB(255, 255, 255)
        End With
        Set rng = Nothing
    End Sub

    Private Sub class_Initialize()
        ' Called automatically when class is created
    End Sub

    Private Sub class_Terminate()
       Set m_sheet = Nothing
       Set m_Items = Nothing
    End Sub


   
end class

class AlCatelogItemClass
    Option Explicit
    Private m_sht As Worksheet
    Private m_yjzh As String
    Private m_LineNo As Long
    Private m_jc As String

    Public Property Get yjzh() As String
        yjzh = m_yjzh
    End Property
    Public Property Let yjzh(value As String)
        m_yjzh = value
    End Property

    Public Property Get jc() As String
        jc = m_jc
    End Property
    Public Property Let jc(value As String)
        m_jc = value
    End Property


  Public Property Get LineNo() As Long
        LineNo = m_LineNo
    End Property
    Public Property Let LineNo(value As Long)
        m_LineNo = value
    End Property

    Public Sub Init(vsht, i)
        Set m_sht = vsht
        m_LineNo = i
        m_yjzh = m_sht.Cells(i, "B")
        m_jc = m_sht.Cells(i, "E")
    End Sub

    '填充Ciam金额
    Sub WriteCiamJe(ciamDict)
        If ciamDict.exists(m_yjzh) Then
            m_sht.Cells(m_LineNo, "H") = ciamDict(m_yjzh)
            
        End If
    End Sub

    ' 金额列 填充 路径
    Sub WriteBill(wb As Workbook, billDict, pSht, summarySht)
        Dim fileName
        Dim wbBill As Workbook, shtBill As Worksheet

        If billDict.exists(m_yjzh) Then
            fileName = billDict(m_yjzh)
            
            Set wbBill = Workbooks.Open(fileName)
            Set shtBill = wbBill.Worksheets(1)
            m_sht.Cells(m_LineNo, "I") = GetJe(shtBill)
            
            '复制并且改名为简称
            shtBill.Copy after:=wb.Worksheets(wb.Worksheets.Count)
            ActiveSheet.Name = Me.jc
            
            wbBill.Close
            Set shtBill = Nothing
            Set wbBill = Nothing
            
            '写汇总表表体
            WriteSummary pSht, summarySht, m_LineNo
        End If
    End Sub

    Private Sub WriteSummary(pSht, summarySht, pLineNum)
        Dim rng As Range
        Set rng = pSht.Range("B" & pLineNum & ",C" & pLineNum & ",D" & pLineNum & ",E" & pLineNum & ",F" & pLineNum & ",I" & pLineNum)
        rng.Copy summarySht.Range("A" & (summarySht.UsedRange.Rows.Count + 1))
        Set rng = Nothing

    
    End Sub

    Private Function GetJe(sht As Worksheet) As String
        
        GetJe = GetRegExp(sht.Range("G6"), "为：([0-9.]+)，")
        
    End Function
    


    Private Sub class_Initialize()
        ' Called automatically when class is created
    End Sub

    Private Sub class_Terminate()
      Set m_sht = Nothing
    End Sub

end class

class CiamClass
    Option Explicit

    Private m_khzq As String
    Private m_Wbname As String
    Private m_Dict As Object
    

    Public Property Get Khzq() As String
         Khzq = m_khzq
    End Property
    Public Property Let Khzq(value As String)
        m_khzq = value
    End Property

    Public Property Get Wbname() As String
        Wbname = m_Wbname
    End Property
    Public Property Let Wbname(value As String)
        m_Wbname = value
    End Property

    Public Property Get dict() As Object
        Set dict = m_Dict
    End Property
    Public Property Set dict(value As Object)
        Set m_Dict = value
    End Property

    Public Sub Init(fname As String, zq As String)
        Me.Khzq = zq
        Me.Wbname = fname
    End Sub

    Public Function GetCiamJeDict()
        Dim wb, sht, dict1
        Set wb = Workbooks.Open(Me.Wbname)
        Set sht = wb.Worksheets(1)
        Dim i, bp, zq, je, dict
        Set dict1 = CreateObject("Scripting.Dictionary")
        For i = 2 To sht.UsedRange.Rows.Count
            bp = sht.Cells(i, "G")
            zq = sht.Cells(i, "O")
            je = sht.Cells(i, "K")
            If zq = Me.Khzq And Not dict1.exists(bp) Then
                dict1(bp) = je
            End If
        Next
        Set sht = Nothing
        wb.Close False
        Set wb = Nothing

        Set Me.dict = dict1
        Set GetCiamJeDict = dict1
    End Function

    Public Sub Display()
        Dim ele
        For Each ele In Me.dict
            Debug.Print ele & " / " & Me.dict(ele)
        Next
    End Sub

    Private Sub class_Initialize()
        ' Called automatically when class is created
    End Sub

    Private Sub class_Terminate()
        ' Called automatically when all references to class instance are removed
    End Sub

end class




class Common
    Option Explicit
    
    '在桌面生成日期时间的文件夹
    Function GetDeskTopTimeDir()
        Dim sj, oWShell, desktopPath, fullpath
        sj = Format(Now(), "yyyyMMdd_hhmmss")
        Set oWShell = CreateObject("WScript.Shell")
        With oWShell
            desktopPath = .specialfolders("Desktop")
        End With
        fullpath = desktopPath & "\" & sj
        If dir(fullpath) = "" Then
            MkDir fullpath
        End If
        
        GetDeskTopTimeDir = fullpath

    End Function

    '返回选择的目录（单个）
    Public Function GetFolder() As String
        Dim fdo
        Set fdo = Excel.Application.FileDialog(msoFileDialogFolderPicker)
        With fdo
            .Title = "请选择文件夹"
        .Show
        If .SelectedItems.Count = 1 Then
            GetFolder = .SelectedItems(1)
            Set fdo = Nothing
            Exit Function
        End If
        End With
        Set fdo = Nothing
        GetFolder = ""
    End Function


    Function GetFilesDict(path)
        Dim dict, fileName
        Set dict = CreateObject("Scripting.Dictionary")
        
        fileName = dir(path & "\*.*")
        Do While fileName <> ""
            dict(GetYjzh(fileName)) = path & "\" & fileName
            fileName = dir()
        Loop
            
        Set GetFilesDict = dict
        Exit Function
    End Function

   
    Function GetYjzh(str)
        Dim reg, mc, m
        Set reg = CreateObject("vbscript.regexp")
        reg.Pattern = "_(\d{10})-"
        reg.Global = True
        Set mc = reg.Execute(str)
        For Each m In mc
            GetYjzh = m.submatches.Item(0)
            Exit Function
        Next

    End Function


    '根据正则提取字符串
    Function GetRegExp(str, regExp)
        Dim reg, mc, m
        Set reg = CreateObject("vbscript.regexp")
        reg.Pattern = regExp '"_(\d{10})-"
        reg.Global = True
        Set mc = reg.Execute(str)
        For Each m In mc
            GetRegExp = m.submatches.Item(0)
            Exit Function
        Next
        GetRegExp = ""
    End Function

end class


class Main
    Option Explicit
    
    Sub Main()
        UserForm1.Show
    End Sub




    Sub Execute(billdir As String, ciamFilename As String, zq As String)
        ' billdir
        ' ciam filename
        ' khzq
        
        If billdir = "" Or ciamFilename = "" Or zq = "" Then Exit Sub
        
        Dim currWb, actsht As Worksheet
        Set currWb = ActiveWorkbook
        
        
        Dim billFileDict
        Set billFileDict = GetFilesDict(billdir)

        Dim destDir
        destDir = GetDeskTopTimeDir()

        
        'Ciam字典
        Dim ciam, tdict, i
        Set ciam = New CiamClass
        With ciam
            .Init ciamFilename, zq
            Set tdict = .GetCiamJeDict()
        End With
        Set ciam = Nothing
        
        Dim alc
        For Each actsht In currWb.Worksheets
            Set alc = New ALCatelogClass
            With alc
                .Init actsht
                .Fill destDir, tdict, billFileDict
            End With
            Set alc = Nothing
        Next
        
        Shell "explorer " & destDir, vbNormalFocus
        
    End Sub

end class