Board logo

標題: [發問] 在excel中資料新增後，Access資料表中的資料會自動更新 [打印本頁]
作者: Changbanana    時間: 2016-9-6 10:46     標題: 在excel中資料新增後，Access資料表中的資料會自動更新

請教各位高手~

目前資料型態有兩個 一個是EXCEL另一個是Access

想要excel的資料新增後

按個按鈕，Access裡的資料就會自動更新

excel:
[attach]25151[/attach]
access:
[attach]25150[/attach]
因為這個錄製巨集也無法成功

網上是有找到直接產生一個資料表

但因還想要用原來的資料表，不要每次更新就新增一個資料表，只需更新資料

要怎麼在excel可以直接操作access的同個資料表呢?

麻煩了~謝謝^ ^
作者: lpk187    時間: 2016-9-6 13:04

本帖最後由 lpk187 於 2016-9-6 13:09 編輯

回復 1# Changbanana

[attach]25159[/attach]
給你參考
作者: Changbanana    時間: 2016-9-6 15:10

本帖最後由 Changbanana 於 2016-9-6 15:12 編輯

回復 2# lpk187


    謝謝你的答覆
   目前若是跑三欄的資料和都有值的話是都有複製過去

但有發現若是中間有空資料就無法做了
可以把key值改成ID嗎?
還有增加欄位的話是不是這樣做?
  1. Public Sub 匯出()
  2.     Dim arr, i%
  3.     Dim myCon As Object, myRs As Object, sql$
  4.     Set myCon = CreateObject("ADODB.Connection")
  5.     Set myRs = CreateObject("ADODB.Recordset")
  6.     myCon.Open "provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & "\test.accdb;"
  7.     arr = Sheets(1).Range("[color=Red]D1[/color]", Sheets(1).[A65535].End(xlUp))
  8.     Set myRs = Nothing
  9.     For i = 1 To UBound(arr)
  10.         sql = "SELECT * FROM 資料表1 WHERE 資料表1.名稱 Like '" & arr(i, 1) & "';"
  11.         Set myRs = myCon.Execute(sql)
  12.         If myRs.EOF = True Then
  13.             sql = "INSERT INTO " & "資料表1" & "(名稱,ID,成績國,[color=Red]成績數[/color])" & _
  14.                   " VALUES('" & arr(i, 1) & "','" & arr(i, 2) & "','" & arr(i, 3) & "'[color=Red]," & arr(i, 4) & "[/color]);"
  15.             Set myRs = myCon.Execute(sql)
  16.         End If
  17.         Set myRs = Nothing
  18.     Next
  19.     Set myRs = Nothing
  20.     myCon.Close
  21.     Set myCon = Nothing

  23. End Sub
複製代碼
成績數是想要增加欄位的資料~
作者: lpk187    時間: 2016-9-6 15:36

回復 3# Changbanana


   把你檔案放上來吧
作者: lpk187    時間: 2016-9-6 16:37

回復 3# Changbanana


   儲存格中沒有資料，在VBA陣列中並不會以為是Null值
而SQL語言中則是必須給他Null值
所以在arr中有空白處，必須把它改成"Null"
所以要多個迴圈去更改他的空值
INSERT INTO是新增資料，若修改表格中的資料就需要用到UPDATE 指令
有關SQL語法，請自行Google "SQL"
  1. Public Sub 匯出()
  2.     Dim arr, i%
  3.     Dim myCon As Object, myRs As Object, sql$
  4.     Set myCon = CreateObject("ADODB.Connection")
  5.     Set myRs = CreateObject("ADODB.Recordset")
  6.     myCon.Open "provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & "\test.accdb;"
  7.     arr = Sheets(1).Range("C1", Sheets(1).[A65535].End(xlUp))
  8.     For i = 1 To UBound(arr)
  9.         For j = 1 To UBound(arr, 2)
  10.             aa = arr(i, j)
  11.             If arr(i, j) = Empty Then
  12.                 arr(i, j) = "Null"
  13.             End If
  14.         Next
  15.     Next
  16.     Set myRs = Nothing
  17.     For i = 1 To UBound(arr)
  18.         sql = "SELECT * FROM 資料表1 WHERE 資料表1.名稱 Like '" & arr(i, 1) & "';"
  19.         Set myRs = myCon.Execute(sql)
  20.         If myRs.EOF = True Then
  21.             sql = "INSERT INTO " & "資料表1" & "(名稱,ID,成績)" & _
  22.                   " VALUES('" & arr(i, 1) & "','" & arr(i, 2) & "'," & arr(i, 3) & ");"
  23.             Set myRs = myCon.Execute(sql)
  24.         End If
  25.         Set myRs = Nothing
  26.     Next
  27.     Set myRs = Nothing
  28.     myCon.Close
  29.     Set myCon = Nothing

  31. End Sub
複製代碼
作者: lpk187    時間: 2016-9-6 17:36

本帖最後由 lpk187 於 2016-9-6 17:38 編輯

回復 3# Changbanana


    反過來 在匯入資料時，ax = myRs.GetRows是都有資料的情況下使其成為陣列，
但是其中若有空值時(Null)，其ax陣列中也會為Null 所以不能用陣列直接輸入資料
所以匯入也要修改
  1. Public Sub 匯入()
  2.     Dim myRs As ADODB.Recordset '連結資料表
  3.     Dim myCon As Object, sql$
  4.     Set myCon = CreateObject("ADODB.Connection")
  5.     Set myRs = CreateObject("ADODB.Recordset")
  6.     myCon.Open "provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & "\test.accdb;"
  7.     Sheets(1).Range("C1", Sheets(1).[A65535].End(xlUp)).Clear
  8.     sql = "SELECT * FROM 資料表1 ORDER BY 資料表1.ID;"
  9.     Set myRs = myCon.Execute(sql)
  10.     ro = 1
  11.     Do While Not myRs.EOF
  12.             Sheets(1).Cells(ro, 1) = myRs.Fields(0).Value
  13.             Sheets(1).Cells(ro, 2) = myRs.Fields(1).Value
  14.             Sheets(1).Cells(ro, 3) = myRs.Fields(2).Value
  15.             ro = ro + 1
  16.         myRs.MoveNext
  17.     Loop
  18.     Set myRs = Nothing
  19.     myCon.Close
  20.     Set myCon = Nothing
  21. End Sub
複製代碼
作者: Changbanana    時間: 2016-9-7 21:31

回復 4# lpk187

[attach]25173[/attach]

以上附上檔案~~

謝謝你的幫忙

還在研究中@@



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)