Ghi Dữ Liệu Vào File Đóng Bằng ADO

Liên hệ QC

Kiều Mạnh

I don't program, I beat code into submission!!!
Tham gia
9/6/12
Bài viết
5,421
Được thích
4,033
Giới tính
Nam
Mình có viết một chương trình Bán hàng...sử dụng VBA để ghi dữ liệu từ file chuơngTrinh.xlsb vào File Data.xlsb hiện tại sử dụng tốt ...
Nhưng khi dữ liệu File Data càng lớn thì thấy nó hơi chậm lại...vì vậy mình muốn chuyển qua sử dụng ADO với code có chức năng tương tự nhưng kẹt chưa làm được ...Vậy úp lên nhờ các Bạn trợ giúp

1/ vùng dữ liệu cần ghi từ File chuongTrinh là [A6:J82]

2/ điều kiện ghi là từ [C6:C82] nếu Cells nào có dữ liệu thì lọc ghi theo dòng đó (khó khúc này ADO là mình Tịt...Nếu ghi nguyên vùng thì OK)

3/ Ghi vào Sheets("Data_Ban")File Data.xlsb nối tiếp xuống dưới tương tự như Code VBA mình viết....sau khi ghi xong thì chay Sub Auto_Open trong File Data.xlsb
Xin cảm ơn các Bạn đã trợ giúp...
Code VBA
PHP:
Public Sub LuuData_Ban()
Application.ScreenUpdating = False
Dim Nguon(), Kq(), i&, j&, k&
Nguon = ActiveSheet.Range("A6:J82").Value
ReDim Kq(1 To UBound(Nguon, 1), 1 To UBound(Nguon, 2))
For i = 1 To UBound(Nguon, 1)
    If Nguon(i, 3) <> "" Then 
       k = k + 1
        For j = 1 To UBound(Nguon, 2)
            Kq(k, j) = Nguon(i, j)
        Next
    End If
Next
With Workbooks.Open(ThisWorkbook.Path & "\Data.xlsb", 0)
    .Sheets("Data_Ban").Range("A65536").End(3)(2).Resize(k, UBound(Nguon, 2)) = Kq
    .RunAutoMacros (xlAutoOpen) ''Chay Sub Auto_Open Trong File Data
    .Close True
End With
Application.ScreenUpdating = True
End Sub
 

File đính kèm

  • Hoi Bai.rar
    38.8 KB · Đọc: 71
ồ ai đây ta ?
mấy cái này có thể làm khó nhà bác học Kiều Mạnh sao ? hí hí
 
Upvote 0
Bạn hiền xử cho một tay đi .....ADO mình kém lắm mấy cái thông thường thì cũng mằn được còn cái này thì Tịt.........--=0--=0
theo hiểu biết của tôi mà muốn dùng ADO để gọi SUB của file đang đóng e là chuyện động trời .
nhưng mà có cần thiết phải gọi sub Auto_open , chạy code tương tự các dòng trong Sub Auto_open là được chứ gì ?
 
Upvote 0
theo hiểu biết của tôi mà muốn dùng ADO để gọi SUB của file đang đóng e là chuyện động trời .
nhưng mà có cần thiết phải gọi sub Auto_open , chạy code tương tự các dòng trong Sub Auto_open là được chứ gì ?
Phải chạy Sub Auto_Open Trong File Data Vì khi Mình nhập hàng hay xuất hàng thì nó tổng hợp Nhập Xuất Tồn Luôn và trả kết quả về File chương Trình tức thì để mình Kiểm hàng....vì vậy không Thể bỏ được...
Và còn kèm thêm Một sub khác chạy theo nữa ....mình chưa viết trong đó thôi
 
Lần chỉnh sửa cuối:
Upvote 0
Phải chạy Sub Auto_Open Trong File Data Vì khi Mình nhập hàng hay xuất hàng thì nó tổng hợp Nhập Xuất Tồn Luôn và trả kết quả về File chương Trình tức thì để mình Kiểm hàng....vì vậy không Thể bỏ được...
Và còn kèm thêm Một sub khác chạy theo nữa ....mình chưa viết trong đó thôi

vậy tôi cập nhật dữ liệu từ sheet Data_ban vào thẳng cột M:N luôn ngay sau khi ghi dữ liệu lên sheet Data_ban được không ?
 
Upvote 0
vậy tôi cập nhật dữ liệu từ sheet Data_ban vào thẳng cột M:N luôn ngay sau khi ghi dữ liệu lên sheet Data_ban được không ?
Vậy cũng được mình lại viết thêm Sub khác lấy lên cũng Ok....
Nhưng Sub Auto_Open Phải chạy vì còn liên quan mấy sub khác nữa.....
Vụ này Làm Sao mà làm Khó bạn hiền được chứ
hay chơi kiểu sau ... Sau khi ADO ghi xong thì chạy Sub này kể ra thì nó cũng không đẹp lắm
PHP:
Sub Open_CloseFile()
    Application.ScreenUpdating = False
        Dim Openfile
        Openfile = "data.xlsb"
        Workbooks.Open ThisWorkbook.Path & "\" & Openfile
        Workbooks(Openfile).RunAutoMacros (xlAutoOpen)
        Workbooks(Openfile).Close True
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Phải chạy Sub Auto_Open Trong File Data Vì khi Mình nhập hàng hay xuất hàng thì nó tổng hợp Nhập Xuất Tồn Luôn và trả kết quả về File chương Trình tức thì để mình Kiểm hàng....vì vậy không Thể bỏ được...
Và còn kèm thêm Một sub khác chạy theo nữa ....mình chưa viết trong đó thôi
Thay vì viết code trong file đóng đó ta viết trong file mở rồi ghi dữ liệu file đóng đó thử.
 
Upvote 0
đây là code ghi dữ liệu lên sheet Data_ban rồi cập nhật ngược lại vào vùng M:N chứ không đụng chạm gì tới sheet TongHop
Mã:
Public Sub hell()
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open ("provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
        ThisWorkbook.Path & "\data.xlsb" & _
                 ";extended properties=""Excel 12.0;hdr=no"";")
cn.Execute ("insert into [Data_Ban$A2:J] " & _
"select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J] where f3 is not null")
Set rs = cn.Execute("select f1,sum(f2) as f2 from [Data_Ban$B2:C] where f1 is not null group by f1")
Sheet1.Range("M6").CopyFromRecordset rs
rs.Close
cn.Close
End Sub
anh cho xem cái sub auto_open rốt cục chứa cái gì đã rồi mới tính tiếp được
 
Upvote 0
đây là code ghi dữ liệu lên sheet Data_ban rồi cập nhật ngược lại vào vùng M:N chứ không đụng chạm gì tới sheet TongHop
Mã:
Public Sub hell()
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open ("provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
        ThisWorkbook.Path & "\data.xlsb" & _
                 ";extended properties=""Excel 12.0;hdr=no"";")
cn.Execute ("insert into [Data_Ban$A2:J] " & _
"select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J] where f3 is not null")
Set rs = cn.Execute("select f1,sum(f2) as f2 from [Data_Ban$B2:C] where f1 is not null group by f1")
Sheet1.Range("M6").CopyFromRecordset rs
rs.Close
cn.Close
End Sub
anh cho xem cái sub auto_open rốt cục chứa cái gì đã rồi mới tính tiếp được
Mô tả Sub Auto_Open()
1/ Khi mình nhập hàng thì từ File ChuongTrinh Sẽ nhập Ghi vào File Data và Bán hàng Cũng vậy

2/ khi nhập hay bán xong thì sub Auto_Open() nó sẽ tổng hợp lại Xuất Nhập Tồn Xuất qua Sheet TongHop Từ Sheet TongHop nó sẽ báo cho mình biết tồn kho còn bao nhiêu và xuất kết quả ngược lại File ChuongTrinh như Cột [M:N] đó mình biết xử lý hàng tồn kho luôn tức thì
Chỉ cần Từ File ChuongTrinh Ghi xong Chạy Sub Auto_Open là ok rồi

Nó chạy dòng dòng vậy đó....VBA thì mình xử lý OK ....Còn ADO thì tịt..........--=0
 
Lần chỉnh sửa cuối:
Upvote 0
Mô tả Sub Auto_Open()
1/ Khi mình nhập hàng thì từ File ChuongTrinh Sẽ nhập Ghi vào File Data và Bán hàng Cũng vậy

2/ khi nhập hay bán xong thì sub Auto_Open() nó sẽ tổng hợp lại Xuất Nhập Tồn Xuất qua Sheet TongHop Từ Sheet TongHop nó sẽ báo cho mình biết tồn kho còn bao nhiêu và xuất kết quả ngược lại File ChuongTrinh như Cột [M:N] đó mình biết xử lý hàng tồn kho luôn tức thì
Chỉ cần Từ File ChuongTrinh Ghi xong Chạy Sub Auto_Open là ok rồi

Nó chạy dòng dòng vậy đó....VBA thì mình xử lý OK ....Còn ADO thì tịt..........--=0

như thế là muốn tổng hợp tồn kho thì phải có sheet Data_mua trong file Data.xlsb nữa mới tính được tồn kho . vậy mà file Data anh gửi lên không có sheet này sao tôi tổng hợp ? => có dấu hiệu gian dối
nếu Sub Auto_open chỉ để đi làm ba cái việc tính tồn kho ,cập nhật sheet TongHop, rồi gán kết quả vào cột M:N thì tôi không thấy lý do nào để phải mở file Data lên cả . file Data đóng cũng làm được
bây giờ tôi phải xem cái sheet Data_mua trong file Data.xlsb nó thế nào đã rồi tính tiếp
 
Upvote 0
như thế là muốn tổng hợp tồn kho thì phải có sheet Data_mua trong file Data.xlsb nữa mới tính được tồn kho . vậy mà file Data anh gửi lên không có sheet này sao tôi tổng hợp ? => có dấu hiệu gian dối
nếu Sub Auto_open chỉ để đi làm ba cái việc tính tồn kho ,cập nhật sheet TongHop, rồi gán kết quả vào cột M:N thì tôi không thấy lý do nào để phải mở file Data lên cả . file Data đóng cũng làm được
bây giờ tôi phải xem cái sheet Data_mua trong file Data.xlsb nó thế nào đã rồi tính tiếp
File Data Đây Bạn ...Mình Tổng hợp xong Từ File ChuongTrinh dùng ADO lấy Sheets("NXT").[H3:I200] gán Vào [M:N] là vậy đó....Bạn nghiên cứu Giúp Mình
 

File đính kèm

  • Data.rar
    418.4 KB · Đọc: 60
Upvote 0
Có thể tham gia của mình không đúng với yêu cầu của bạn, bạn nên xem lại và thay đổi cách làm cho nó phù hợp hơn:
-Thằng nào làm kho thì nên phân công nó chuyên làm kho đi, miễn là nó bố trí khoa học, chính xác nhập xuất theo yêu cầu. Nghiêm ngặt qui chế nhập xuất kho theo quy tắc.
-Thằng nào muốn nhập vào thì phải lo thủ tục cho "hàng" của mình vào được kho.
-Thằng nào muốn thông tin thì tự chế biến từ nguyên liệu của kho.

Vậy là file data chứa dữ liệu không phải lo những việc bạn không kiểm soát được. Ví dụ: Đúng lúc bạn chạy cái Sub Auto... có người nhạp sửa dữ liệu là lỗi rồi, file dùng chung thì khó tránh dạng này. Kể cả dùng ADO đi chăng nữa bạn cũng đừng nghĩ là file đó đang đóng im ỉm đâu .

Bạn nên tham kham khảo cách chia file front end - back end của Access ấy. Nó có tiện ích này thật hay, sau khi hoàn thanh file nó giúp tách thành 2 file: 1 file dùng chung và 1 file cho người dùng.
 
Lần chỉnh sửa cuối:
Upvote 0
Có thể tham gia của mình không đúng với yêu cầu của bạn, bạn nên xem lại và thay đổi cách làm cho nó phù hợp hơn:
-Thằng nào làm kho thì nên phân công nó chuyên làm kho đi, miễn là nó bố trí khoa học, chính xác nhập xuất theo yêu cầu. Nghiêm ngặt qui chế nhập xuất kho theo quy tắc.
-Thằng nào muốn nhập vào thì phải lo thủ tục cho "hàng" của mình vào được kho.
-Thằng nào muốn thông tin thì tự chế biến từ nguyên liệu của kho.

Vậy là file data chứa dữ liệu không phải lo những việc bạn không kiểm soát được. Ví dụ: Đúng lúc bạn chạy cái Sub Auto... có người nhạp sửa dữ liệu là lỗi rồi, file dùng chung thì khó tránh dạng này.

Bạn nên tham kham khảo cách chia file front end - back end của Access ấy. Nó có tiện ích này thật hay, sau khi hoàn thanh file nó giúp tách thành 2 file: 1 file dùng chung và 1 file cho người dùng.
Access thì mình không rành lắm....
Còn File Data có bao Giờ Mình mở lên đâu mà lo lỗi....mình thiết kế sử dụng cho một một máy và khi sử dụng chỉ chạy mỗi File chương trình thôi ...
khi cần cái gì thì sử dụng ADO lấy lên xem...
 
Upvote 0
file data.xlsb anh có dùng chung với ai ko ???
anh mà share cùng lúc nhiều người xài thì quên luôn cái ADO đi nhé . nếu chỉ mình anh xài mới dùng được
 
Upvote 0
code dưới đây thực hiện các nhiệm vụ
chèn dữ liệu vào sheet Data_Ban
cập nhật lại sheet NGUON
Cập nhật toàn bộ bảng Sheet XNT
gán ngược lại kết quả cho vùng M:N
muốn xài được code này cần phải :
Xóa hết code đang có trong file Data.xlsb
Xóa hết công thức hàng 1 của sheet XNT
Tuyệt đối đóng file Data.xlsb khi chạy code
Mã:
Public Sub GotoHell()
Dim Cn As Object, rs As Object, arrNHAP As Variant, arrBAN As Variant
Dim r As Long, c As Integer, arrSUM(1 To 9) As Double, arrView As Variant
Set Cn = CreateObject("ADODB.Connection")
Cn.Open ("provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
        ThisWorkbook.Path & "\data.xlsb" & _
                 ";extended properties=""Excel 12.0;hdr=no"";")
Cn.Execute ("insert into [Data_Ban$A2:J] " & _
"select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J] where f3 is not null")


Cn.Execute ("insert into [NGUON$B3:B] select a.f1 from " & _
"(select distinct f1 from [Data_Nhap$B2:B] where f1 is not null) a left join " & _
"(select f1 from [NGUON$B3:B] where f1 is not null) b on a.f1 = b.f1 where b.f1 is null")


Set rs = Cn.Execute("select b.f1,a.sf2,a.sf5 from " & _
"(select f1,sum(f2) as sf2,sum(f5) as sf5 from [Data_Nhap$B2:F] " & _
"where f1 is not null group by f1 ) a " & _
"right join (select f1 from [NGUON$B3:B] where f1 is not null) b " & _
"on a.f1 = b.f1 order by b.f1")
arrNHAP = rs.GetRows
rs.Close


Set rs = Cn.Execute("select b.f1,a.sf2,a.sf5 from " & _
"(select f1,sum(f2) as sf2,sum(f5) as sf5 from [Data_Ban$B2:F] " & _
"where f1 is not null group by f1 ) a " & _
"right join (select f1 from [NGUON$B3:B] where f1 is not null) b " & _
"on a.f1 = b.f1 order by b.f1")
arrBAN = rs.GetRows
rs.Close


rs.Open "select * from [XNT$B1:K" & UBound(arrBAN, 2) + 3 & "]", Cn, , 3
rs.MoveNext
rs.MoveNext
ReDim arrView(1 To UBound(arrBAN, 2) + 1, 1 To 2)
For r = 0 To UBound(arrBAN, 2) Step 1
    arrView(r + 1, 1) = arrNHAP(0, r)
    rs("f1") = arrNHAP(0, r)
    rs("f2") = arrNHAP(1, r)
    rs("f3") = arrNHAP(2, r)
    rs("f4") = arrBAN(0, r)
    rs("f5") = arrBAN(1, r)
    rs("f6") = arrBAN(2, r)
    rs("f7") = arrBAN(0, r)
    If IsNumeric(arrNHAP(1, r)) And IsNumeric(arrNHAP(2, r)) And _
       IsNumeric(arrBAN(1, r)) And IsNumeric(arrBAN(2, r)) Then
        rs("f8") = arrNHAP(1, r) - arrBAN(1, r)
        rs("f9") = (arrBAN(2, r) / arrBAN(1, r) - arrNHAP(2, r) / arrNHAP(1, r)) * arrBAN(1, r)
        rs("f10") = arrNHAP(2, r) - arrBAN(2, r) + rs("f9")
    Else
        rs("f8") = 0
        rs("f9") = 0
        rs("f10") = 0
    End If
    arrView(r + 1, 2) = rs("f8")
    For c = 2 To 10 Step 1
        If IsNumeric(rs("f" & c)) Then arrSUM(c - 1) = arrSUM(c - 1) + rs("f" & c)
    Next
    rs.MoveNext
Next
rs.MoveFirst
For c = 2 To 10 Step 1
    If arrSUM(c - 1) > 0 Then rs("f" & c) = arrSUM(c - 1)
Next
rs.MoveLast
rs.Close
Cn.Close
Sheet1.Range("M6:N1000").ClearContents
Sheet1.Range("M6").Resize(UBound(arrView), 2).Value = arrView
End Sub
 
Upvote 0
Bạn hiền Mình chạy Thấy lỗi....Khiếp ...Code viết dữ quá nhìn thấy sợ luôn
Hay bạn sửa lại Code sau (Của Bạn) cho Mình chỉ cần Ghi dữ liệu Vùng [A6:j82] theo điều Kiện Cột [C6:C82] vào File Data Là Ok rồi Còn lại mình Tự Xử Được
PHP:
Public Sub hell()
Dim Cn As Object, rs As Object
Set Cn = CreateObject("ADODB.Connection")
Cn.Open ("provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
        ThisWorkbook.Path & "\data.xlsb" & _
                 ";extended properties=""Excel 12.0;hdr=no"";")
Cn.Execute ("insert into [Data_Ban$A2:J] " & _
"select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J] where f3 is not null")
Set rs = Cn.Execute("select f1,sum(f2) as f2 from [Data_Ban$B2:C] where f1 is not null group by f1")
Sheet1.Range("M6").CopyFromRecordset rs '''Bo khong su dung
rs.Close
Cn.Close
Call Open_CloseFile
End Sub
Xong Mình Chạy Sub sau cũng được vậy
PHP:
Sub Open_CloseFile()
    Application.ScreenUpdating = False
        Dim Openfile As String
        Openfile = "data.xlsb"
        Workbooks.Open ThisWorkbook.Path & "\" & Openfile
        Workbooks(Openfile).RunAutoMacros (xlAutoOpen)
        Workbooks(Openfile).Close True
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
nếu chỉ làm đúng cái nhiệm vụ ghi [A6:j82] vào file Data thì thôi khỏi xài ADO luôn cho khỏe .
nếu đã xài ADO thì chơi tới bến , không thì khỏi xài chứ làm nữa vời chả ra cái gì
 
Upvote 0
Web KT
Back
Top Bottom