excel学习库

瞬间完成很多重复的工作

一、开发工具---VB编辑器

二、双击Sheet1，输入VBA代码

具体代码如下，仅供参考：

Option Explicit
Dim oCnn As Object, oRst As Object, sFile As String
Sub openSQL()
    Set oCnn = CreateObject("adodb.connection")
    Set oRst = CreateObject("adodb.recordset")
    oCnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
End Sub
Sub closeSQL()
    If oRst.State = 1 Then oRst.Close
    If oCnn.State = 1 Then oCnn.Close
    Set oRst = Nothing
    Set oCnn = Nothing
End Sub
Sub fenbiao()
    Dim sql As String, sql2 As String
    Dim Arr_CateNumS, Arr_CateNumI
    Dim Arr_Cate
    
    openSQL
    sql = "select 单位名称 as wjm from [Sheet1$a3:l295] group by 单位名称"
    oRst.Open sql, oCnn, 1, 1
    Arr_Cate = oRst.getrows()
    Arr_CateNumS = UBound(Arr_Cate, 2)
    For Arr_CateNumI = 0 To Arr_CateNumS
       Debug.Print Arr_Cate(0, Arr_CateNumI)
       sFile = ThisWorkbook.Path & "\" & Arr_Cate(0, Arr_CateNumI) & ".xls"
       If Dir(sFile) <> "" Then Kill sFile
      sql2 = "select * into " & sFile & " from (select 序号,单位名称,社会保障号码,姓名,离退休日期,减员日期,[2016增资],[2017增资],[2018增资],[2019增资],[2020增资],[增资额合计] from [Sheet1$a3:l295] where 单位名称='" & Arr_Cate(0, Arr_CateNumI) & "') a"
       Debug.Print sql2
       oCnn.Execute sql2
    Next
    closeSQL

End Sub

三、工具---宏

四、选择相关函数----运行

五、通过立即窗口，可以看到运行过程中的输出语句