Đọc ghi dữ liệu với mảng Array vào Sheet và vào Bảng trong Accsess

Blue Softs Liên hệ QC

ngocbinh.no.kia

Thành viên mới
Tham gia
25/1/11
Bài viết
39
Được thích
0
Tôi có một file mẫu excel đang loay hoay đọc ghi dữ liệu vào sheets DATA và đọc ghi dữ liệu vào một file accsees có bảng giống bảng sheest DATA; nhờ các cao nhân giúp hoàn thiện Code VBA
 

File đính kèm

  • GPE_LuuDATA_Array.xlsm
    42.9 KB · Đọc: 14

Maika8008

Thành viên gắn bó
Tham gia
12/6/20
Bài viết
2,511
Được thích
2,752
Donate (Momo)
Donate
Giới tính
Nam
Tôi gửi bạn code lấy chép tất cả các sheet của 1 file đang đóng sang Access, mỗi sheet thành 1 table Access.

Dữ liệu file Excel bắt đầu từ cột A, dòng 1 là tiêu đề.
Rich (BB code):
Sub AccImport()
    Dim Sh As Worksheet, C&, R&, Adrs$, CName$
    Dim WbD As Workbook
    Dim acc As New Access.Application
    Application.ScreenUpdating = False
    acc.OpenCurrentDatabase "D:\TestGPE\DataTN1.accdb"  'Thay duong dan va ten
    Set WbD = Workbooks.Open("D:\TestGPE\DuLieu.xlsx")  ''Thay duong dan va ten
    For Each Sh In WbD.Worksheets
        C = Sh.Range("XFD1").End(xlToLeft).Column
        CName = Mid(Cells(1, C).Address, 2, InStrRev(Cells(1, C).Address, "$") - 2)
        R = Sh.Range("A" & Rows.Count).End(xlUp).Row
        Adrs = Sh.Name & "$A1:" & CName & R
        acc.DoCmd.TransferSpreadsheet _
                TransferType:=acImport, _
                SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
                TableName:=Sh.Name, _
                Filename:=WbD.FullName, _
                HasFieldNames:=True, _
                Range:=Adrs
    Next
    WbD.Close False
    Set WbD = Nothing
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
    Application.ScreenUpdating = True
End Sub
 

ngocbinh.no.kia

Thành viên mới
Tham gia
25/1/11
Bài viết
39
Được thích
0
Tôi gửi bạn code lấy chép tất cả các sheet của 1 file đang đóng sang Access, mỗi sheet thành 1 table Access.

Dữ liệu file Excel bắt đầu từ cột A, dòng 1 là tiêu đề.
Rich (BB code):
Sub AccImport()
    Dim Sh As Worksheet, C&, R&, Adrs$, CName$
    Dim WbD As Workbook
    Dim acc As New Access.Application
    Application.ScreenUpdating = False
    acc.OpenCurrentDatabase "D:\TestGPE\DataTN1.accdb"  'Thay duong dan va ten
    Set WbD = Workbooks.Open("D:\TestGPE\DuLieu.xlsx")  ''Thay duong dan va ten
    For Each Sh In WbD.Worksheets
        C = Sh.Range("XFD1").End(xlToLeft).Column
        CName = Mid(Cells(1, C).Address, 2, InStrRev(Cells(1, C).Address, "$") - 2)
        R = Sh.Range("A" & Rows.Count).End(xlUp).Row
        Adrs = Sh.Name & "$A1:" & CName & R
        acc.DoCmd.TransferSpreadsheet _
                TransferType:=acImport, _
                SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
                TableName:=Sh.Name, _
                Filename:=WbD.FullName, _
                HasFieldNames:=True, _
                Range:=Adrs
    Next
    WbD.Close False
    Set WbD = Nothing
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
    Application.ScreenUpdating = True
End Sub
Cái này không cần đến, chủ yếu là cập nhật, sửa, xoá dữ liệu trong bảng thì hữu dụng hơn, dù sao cũng cảm ơn bạn đã quan tâm
 

Maika8008

Thành viên gắn bó
Tham gia
12/6/20
Bài viết
2,511
Được thích
2,752
Donate (Momo)
Donate
Giới tính
Nam

ngocbinh.no.kia

Thành viên mới
Tham gia
25/1/11
Bài viết
39
Được thích
0
Ờ, không cần sao ta? Nếu ai đó giúp code tổng hợp Excel rồi thì làm sao cho vào Access?
Ồ ha; cứ lưu lại rồi sẽ cần; Bác cho hỏi thêm xem ưu điểm của Phương pháp (đoạn code) đó là gì; chạy thử thấy cũng hay hay
Bài đã được tự động gộp:

Có chỉ định lấy sheet cụ thể nào sang được không; vì hình như quét tất cả sheet thì sẽ bị lỗi.
 

File đính kèm

  • Screenshot 2021-09-03 21.38.47.png
    Screenshot 2021-09-03 21.38.47.png
    6.3 KB · Đọc: 4
Lần chỉnh sửa cuối:

Maika8008

Thành viên gắn bó
Tham gia
12/6/20
Bài viết
2,511
Được thích
2,752
Donate (Momo)
Donate
Giới tính
Nam
Ồ ha; cứ lưu lại rồi sẽ cần; Bác cho hỏi thêm xem ưu điểm của Phương pháp (đoạn code) đó là gì; chạy thử thấy cũng hay hay
Bài đã được tự động gộp:

Có chỉ định lấy sheet cụ thể nào sang được không; vì hình như quét tất cả sheet thì sẽ bị lỗi.
Chỉ định sheet cụ thể nào đó thì bỏ vòng lặp đi, ghi rõ sheet name. Dữ liệu hầm bà lằng thì lỗi thôi.
 

ngocbinh.no.kia

Thành viên mới
Tham gia
25/1/11
Bài viết
39
Được thích
0
Tìm được cái code UPDATE 1 dòng vào bảng: Ghi dữ liệu từ Sheets("DATA") vào Bảng DATA_HD trong Accsess có cùng cấu trúc bảng.
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim qry As String
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\BDATA.accdb" ' Thay doi duong dan file access
' Ghi du lieu vao bang DATA_HD
If Range("SOHD").Value <> "" Then
qry = "SELECT * FROM DATA_HD WHERE SOHD = " & Range("SOHD").Value
Else
qry = "SELECT * FROM DATA_HD Where SOHD = 0"
End If

rst.Open qry, cnn, adOpenKeyset, adLockOptimistic

If rst.RecordCount = 0 Then
rst.AddNew
End If
' Ghi du lieu dong 2 sheets DATA vao bang trong accsess
For i = 1 to 50
rst.Fields(i).Value = sheets("DATA").cells(2,i).value
next i
rst.update

rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
MsgBox "Updated Successfully", vbInformation
End Sub
 

Maika8008

Thành viên gắn bó
Tham gia
12/6/20
Bài viết
2,511
Được thích
2,752
Donate (Momo)
Donate
Giới tính
Nam
Ủa, chứ việc loay hoay kia quên mất rồi sao?
 
Top Bottom