带窗体和宏的工作簿另存为普通工作簿

Private Sub CommandButton1_Click()
    respath = 选择文件夹
    TextBox3.Text = respath
    res_sava_as_path = TextBox3.Value
    main
    activeWorkBookSaveAs
    Unload UserForm1
    MsgBox "OK"
End Sub

'
' ThisWorkbook.Sheets(Array("审核要点", "管控", "投资分解表", "任务书文号", "2020年项目", "2021年项目")).Copy
'    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.path & "\汇总后.xlsx"
Private Sub activeWorkBookSaveAs() '表格另存
    Application.DisplayAlerts = False
    LastMonth = Format(Second(Now) - 1, "0000")
    CurrentYear = Year(Now)
    workbookname = CurrentYear & LastMonth & "银行数据与发票系统数据匹配结果"
    'ActiveWorkbook.SaveAs Filename:="F:\C.账务核对-TimeNode-Day20-25\m.红单汇总\" & workbookname & ".xlsx"
    ThisWorkbook.Sheets(Array("两表都有", "银行文件独有", "发票系统独有")).Copy
    With ActiveWorkbook
        '        .Worksheets.Copy
        '        Dim shp As Object
        ''        .Activate
        '        For Each shp In .ActiveSheet.Shapes
        '            If shp.Type = msoOLEControlObject Then
        '            Else
        '                shp.Delete
        '            End If
        '        Next shp
        '        .SaveAs Filename:=res_sava_as_path & workbookname & ".xlsx", FileFormat:=xlWorkbookNormal, CreateBackup:=False
        r = .Sheets("两表都有").Cells(Rows.Count, 1).End(xlUp).Row
        .Sheets("两表都有").Range("a2:a" & r).Interior.ColorIndex = 3
        .SaveAs Filename:=res_sava_as_path & workbookname & ".xlsx"
        .Close
    End With
    Application.DisplayAlerts = True
End Sub

Sub 清空旧数据()
    With Sheets("两表都有")
        .Range("a2").Resize(65535, 4).ClearContents
    End With
    With Sheets("银行文件独有")
        .Range("a2").Resize(65535, 4).ClearContents
    End With
    With Sheets("发票系统独有")
        .Range("a2").Resize(65535, 4).ClearContents
    End With
End Sub

Private Sub CommandButton2_Click() '发票系统
    Call 清空旧数据
    path = ThisWorkbook.path & "\"
    res = pathSelected_ykfp(path)
    TextBox2.Text = res
    '    main
    '    Unload UserForm1
    '    MsgBox "OK"
End Sub

Private Sub CommandButton3_Click() '银行文件
    path = ThisWorkbook.path & "\"
    res = pathSelected(path)
    TextBox1.Text = res
End Sub

Function 选择文件夹()
    With Application.FileDialog(msoFileDialogFolderPicker)
        '        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show = False Then Exit Function
        '        ss = .SelectedItems(1)
        p = Split(.SelectedItems(1), ".")(0) & "\"
    End With
    选择文件夹 = p
End Function

Private Function pathSelected(path) '文件
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "文本文件", "*.CSV"  '设置过滤器
        .InitialFileName = path
        .Title = "historydetail表格"
        .AllowMultiSelect = False
        If .Show Then p = .SelectedItems(1) Else: Exit Function
    End With
    pathSelected = p
End Function

Private Function pathSelected_ykfp(path) '文件
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "文本文件", "*.xls;*.xlsx" '设置过滤器
        .InitialFileName = path
        .Title = "已开发票数据导出表格"
        .AllowMultiSelect = False
        If .Show Then p = .SelectedItems(1) Else: Exit Function
    End With
    pathSelected_ykfp = p
End Function

Sub main()
    Dim rng As Range
    Application.ScreenUpdating = False
    '    Call main.initData
    Call getData
    Set d_银行文件 = CreateObject("scripting.dictionary")
    Set d_发票系统 = CreateObject("scripting.dictionary")
    For x = 2 To UBound(brr_发票系统)
        s = brr_发票系统(x, 1) & "," & brr_发票系统(x, 3)
        d_发票系统(s) = brr_发票系统(x, 2)
    Next
    For x = 2 To UBound(brr_银行文件)
        s2 = brr_银行文件(x, 3) & "," & brr_银行文件(x, 2)
        d_银行文件(s2) = brr_银行文件(x, 1)
    Next
    Call 双字典循环比对
    '    With Sheets("历史数据")
    '        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    '        For x = 2 To lastRow
    '            ss = .Cells(x, 3).Value & "," & .Cells(x, 2).Value
    '            If d.exists(ss) Then
    '                .Cells(x, 4) = d(ss)
    '                If rng Is Nothing Then '看见星光老师加的代码，给A有B无型号的单元格着色。
    '                    Set rng = Cells(x, "c")
    '                Else
    '                    Set rng = Union(rng, Cells(x, "c"))
    '                End If
    '            End If
    '        Next
    '        If Not rng Is Nothing Then rng.Interior.ColorIndex = 3
    '    End With
    '    Call main.dataFormat
    '    mb.closeMsgboxAfter1SecondM3
    Application.ScreenUpdating = True
End Sub

Sub 双字典循环比对()
    k = 1
    Dim rng As Range
    With Sheets("两表都有")
        .Cells.Interior.ColorIndex = 0
        For Each a In d_银行文件
            If d_发票系统.exists(a) Then
                k = k + 1
                .Cells(k, 1) = Split(a, ",")(0)
                .Cells(k, 2) = Split(a, ",")(1)
                .Cells(k, 3) = d_发票系统(a)
                .Cells(k, 4) = d_银行文件(a)
                d_发票系统.Remove (a)
                d_银行文件.Remove (a)
            End If
        Next
        '       lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        '            For x = 2 To lastRow
        '
        '                    If rng Is Nothing Then '看见星光老师加的代码，给A有B无型号的单元格着色。
        '                        Set rng = Cells(x, "a")
        '                    Else
        '                        Set rng = Union(rng, Cells(x, "a"))
        '                    End If
        '
        '            Next
        '            If Not rng Is Nothing Then rng.Interior.ColorIndex = 3
    End With
    Call 输出银行文件数据
    Call 输出发票系统数据
End Sub

Sub 输出银行文件数据()
    k = 1
    For Each a In d_银行文件
        With Sheets("银行文件独有")
            k = k + 1
            .Cells(k, 1) = Split(a, ",")(0)
            .Cells(k, 2) = Split(a, ",")(1)
            .Cells(k, 3) = d_银行文件(a)
        End With
    Next
End Sub

Sub 输出发票系统数据()
    k = 1
    For Each a In d_发票系统
        With Sheets("发票系统独有")
            k = k + 1
            .Cells(k, 1) = Split(a, ",")(0)
            .Cells(k, 2) = Split(a, ",")(1)
            .Cells(k, 3) = d_发票系统(a)
        End With
    Next
End Sub

Private Sub dataFormat()
    With Sheets("历史数据")
        .Range("a1").CurrentRegion.Borders.LineStyle = 1
    End With
End Sub

Private Sub getData()
    path = ThisWorkbook.path & "\"
    '    p = pathSelected(path)
    p = TextBox1.Value
    If p = "" Then End
    Application.ScreenUpdating = False
    '    p_ykfp = pathSelected_ykfp(path)
    p_ykfp = TextBox2.Value
    If p_ykfp = "" Then End
    With GetObject(p_ykfp)
        brr_发票系统 = .Sheets("sheet1").[a1].CurrentRegion
        .Close False
    End With
    With GetObject(p)
        brr_银行文件 = .Sheets("historydetail730").[a1].CurrentRegion
        .Close False
    End With
    With Sheets("历史数据")
        .Range("a1").Resize(UBound(brr_银行文件), UBound(brr_银行文件, 2)) = brr_银行文件
    End With
    With Sheets("已开票数据")
        .Range("a1").Resize(UBound(brr_发票系统), UBound(brr_发票系统, 2)) = brr_brr_发票系统ykfp
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Click()
End Sub

Public brr_银行文件, brr_发票系统
Public d_银行文件, d_发票系统
Public res_sava_as_path

Sub initData()
    With Sheets("历史数据")
        .Cells.ClearContents
        .Cells.Interior.ColorIndex = 0
        .[d1] = "开票日期"
    End With
End Sub
Sub 打开窗体()
    UserForm1.Show
End Sub


Private Function pathSelected(path) '文件
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "文本文件", "*.CSV"  '设置过滤器
        .InitialFileName = path
        .Title = "historydetail表格"
        .AllowMultiSelect = False
        If .Show Then p = .SelectedItems(1) Else: Exit Function
    End With
    pathSelected = p
End Function

Private Function pathSelected_ykfp(path) '文件
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "文本文件", "*.xls;*.xlsx" '设置过滤器
        .InitialFileName = path
        .Title = "已开发票数据导出表格"
        .AllowMultiSelect = False
        If .Show Then p = .SelectedItems(1) Else: Exit Function
    End With
    pathSelected_ykfp = p
End Function