office交流網(wǎng)--QQ交流群號及微信交流群

Access培訓(xùn)群:792054000         Excel免費(fèi)交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

微信交流群(請用微信掃碼)

        

Access以記錄作為表名,創(chuàng)建數(shù)據(jù)表同時(shí)添加數(shù)據(jù)

2017-12-13 16:36:00
tmtony8
原創(chuàng)
5475

 網(wǎng)友“網(wǎng)速很慢”希望從一張Excel總表中,按其中一列進(jìn)行拆分表。同時(shí)同一樣的記錄追加到該表中

我的這個(gè)表有好多行。 比如姓名行 劉德華原表10行 拆出劉德華這個(gè)表,里面有劉德華10條數(shù)據(jù)


如有表“表1”,把此表以姓名作為表名拆分出多個(gè)表,并把同名字的記錄添加的新建的表中


效果圖:


詳細(xì)源碼:

Public Sub TableJionName()
    Dim strSQL, strsql2 As String
    
    Dim rs As New ADODB.Recordset
    Dim rs2 As New ADODB.Recordset
    strSQL = "Select 姓名 from 表1 "
    
    rs.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    Do While Not rs.EOF
        If TableIsIn(rs("姓名")) = False Then
            CurrentDb.Execute "CREATE TABLE " & rs("姓名") & "([姓名] text)"
           
        End If
           strsql2 = "Select 姓名 from " & rs("姓名") & ""
           rs2.Open strsql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
           rs2.AddNew
           rs2("姓名") = rs("姓名")
           
           rs2.Update
           rs2.Close
        rs.MoveNext
    Loop
       
         
            
End Sub
Function TableIsIn(TableName As String)
    TableIsIn = True
    On Error Resume Next
    Dim strSQL As String
    strSQL = "select * from " & TableName
    CurrentDb.Execute strSQL
    If Err.Number = 3078 Then
        TableIsIn = False
    End If
    
End Function


這里調(diào)用了《Access判斷數(shù)據(jù)表是否存在》 一文中的函數(shù)。通過該函數(shù)判斷表是否存在,如果不存在即創(chuàng)建新的表同時(shí)添加記錄,如果存在即往表中添加記錄。

    分享
    文章分類
    聯(lián)系我們
    聯(lián)系人: 王先生
    Email: 18449932@qq.com
    QQ: 18449932
    微博: officecn01
    移動訪問