Ghi Dữ Liệu Vào File Đóng Bằng ADO (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Kiều Mạnh

Kiều Mạnh

I don't program, I beat code into submission!!!
Tham gia
9/6/12
Bài viết
5,538
Được thích
4,133
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

Sắp xếp theo thời gian sắp xếp theo bầu chọn
ồ 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 1
kieu manh đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
doveandrose đã viết:
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ì ?
Nhấp chuột vào đây để mở rộng...
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
kieu manh đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
doveandrose đã viết:
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 ?
Nhấp chuột vào đây để mở rộ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
kieu manh đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
doveandrose đã viết:
đâ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
Nhấp chuột vào đây để mở rộng...
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
kieu manh đã viết:
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ấp chuột vào đây để mở rộng...

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
doveandrose đã viết:
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
Nhấp chuột vào đây để mở rộng...
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

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
sealand đã viết:
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.
Nhấp chuột vào đây để mở rộ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
doveandrose đã viết:
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
Nhấp chuột vào đây để mở rộng...
Code dài quá, có thể rút ngắn và viết cho dễ hiểu được không?
 
Upvote 0
Mình dùng Exc2003 nên không thể Test nên chưa biết mục tiêu có đạt không? Đã so sánh với các phương pháp khác chưa? Mong chủ Topic thông tin cho tham khảo cùng.
 
Upvote 0
sealand đã viết:
Mình dùng Exc2003 nên không thể Test nên chưa biết mục tiêu có đạt không? Đã so sánh với các phương pháp khác chưa? Mong chủ Topic thông tin cho tham khảo cùng.
Nhấp chuột vào đây để mở rộng...
1/ Hiện tại cách Bài #1 của mình sử dụng VBA rất tốt ...code dễ hiểu, mình viết được và đồng bộ với code ở File Data. nhưng có nhược điểm là File Data Càng lớn thì Tốc độ chậm lại

2/ Còn Code doveandrose Viết cho có một code bấm cái là xong Nhưng code đó mức độ khó và phức tạp quá nên mình lưu lại để nghiên cứu (Vì mình chưa đủ khả năng tùy chỉnh code đó mà phải lệ thuộc hoàn toàn...nếu Mình ko biết gì về code thì Ok ... còn mình vẫn viết được = VBA)

3/ Mong Muốn của mình là nhờ trợ giúp viết một code bằng ADo có chức năng tương tự code VBA Bài #1 Khi Ghi dữ liệu vào File Data xong Thì Chạy sub Auto_open() File Data....có như vậy thì mình mới làm chủ hoàn toàn được chương trình của mình và mình tùy biến các kiểu được

Xin cảm ơn Các Bạn rất nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
kieu manh đã viết:
1/ Hiện tại cách Bài #1 của mình sử dụng VBA rất tốt ...code dễ hiểu, mình viết được và đồng bộ với code ở File Data. nhưng có nhược điểm là File Data Càng lớn thì Tốc độ chậm lại

2/ Còn Code doveandrose Viết cho có một code bấm cái là xong Nhưng code đó mức độ khó và phức tạp quá nên mình lưu lại để nghiên cứu (Vì mình chưa đủ khả năng tùy chỉnh code đó mà phải lệ thuộc hoàn toàn...nếu Mình ko biết gì về code thì Ok ... còn mình vẫn viết được = VBA)

3/ Mong Muốn của mình là nhờ trợ giúp viết một code bằng ADo có chức năng tương tự code VBA Bài #1 Khi Ghi dữ liệu vào File Data xong Thì Chạy sub Auto_open() File Data....có như vậy thì mình mới làm chủ hoàn toàn được chương trình của mình và mình tuy biến các kiểu được

Xin cảm ơn Các Bạn rất nhiều
Nhấp chuột vào đây để mở rộng...
Sắp xếp lại CSDL, file data thì chỉ để lưu trữ dữ liệu, muốn cần tồn kho thì lấy thẳng ra file báo cáo. Ai lại ghi ngược lại Data cái tồn kho đó làm chi cho tốn bộ nhớ.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Sắp xếp lại CSDL, file data thì chỉ để lưu trữ dữ liệu, muốn cần tồn kho thì lấy thẳng ra file báo cáo. Ai lại ghi ngược lại Data cái tồn kho đó làm chi cho tốn bộ nhớ.
Nhấp chuột vào đây để mở rộng...
Mình thiết kế một Sheet Vùa Bán hàng và Vừa nhập hàng chung Một Sheet chỉ khác nhau Nút lưu bán và lưu Nhập và code khác

Bạn nhìn cái hình mình úp là hiểu ý đồ của mình

1/ Khi mình nhập hay bán hàng cũng từ Form đó nó lưu vào File data sau khi lưu xong Xuất kết quả tồn lên File chương trình cho mình Hai cột Hàng Còn Tồn bên tay Phải hình [M:N]

2/ Mình thiết kế như vậy tiện cho mình bán hàng và nhập hàng khi mình nhập số lượng bán hay nhập thì mình nhìn qua hai cột Hàng Còn Tồn thì biết còn bao nhiêu mà nhập và bán

3/ Trong Private Sub Worksheet_Change(ByVal Target As Range) Mình viết code Check điều kiện Cột [C6:C82] với cột số lượng tồn [M:N] nếu số lượng vượt Quá tồn thì không cho xuất

4/ Tóm lại mình vừa bán hàng, nhập hàng mà kiểm soát được hết số lượng nhập vào và bán ra theo hai cột Hàng Còn Tồn bên tay phải hình [M:N]

 

File đính kèm

  • Capture.jpg
    Capture.jpg
    24 KB · Đọc: 85
Lần chỉnh sửa cuối:
Upvote 0
kieu manh đã viết:
Mình thiết kế một Sheet Vùa Bán hàng và Vừa nhập hàng chung Một Sheet chỉ khác nhau Nút lưu bán và lưu Nhập và code khác

Bạn hình cái hình mình úp là hiểu ý đồ của mình

1/ khi mình nhập hàng vào cũng từ Form đó nó lưu vào File data sau khi lưu xong Xuất kết quả tồn lên File chương trình cho mình Hai cột hàng còn tồn bên tay Phải hình [M:N]

2/ Mình thiết kế như vậy tiện cho mình bán hàng và nhập hàng khi mình nhập số lượng bán hay nhập thì mình nhìn qua hai cột Hàng còn tồn thì biết còn bao nhiêu mà nhập và bán

3/ Trong Private Sub Worksheet_Change(ByVal Target As Range) Mình viết code Check điều kiện Cột [C6:C82] với cột số lượng tồn nếu số lượng vượt Quá tồn thì không cho xuất

4/ Tóm lại mình vừa bán hàng, nhập hàng mà kiểm soát được hết số lượng nhập vào và bán ra theo hai cột Hàng Còn Tồn bên tay phải hình
Nhấp chuột vào đây để mở rộng...
Thì chỉ việc ghi data nhập hoặc xuất vào file data để lưu trữ, sau khi nhập hoặc xuất = 1 file khác vào data thì tính toán số tồn kho thực tế đưa vào bên phải hay ở đâu đó tuỳ bạn. Sao phải nhất thiết là ghi số tồn kho đó vào file data rồi lấy ngược ra lại?
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Thì chỉ việc ghi data nhập hoặc xuất vào file data để lưu trữ, sau khi nhập hoặc xuất = 1 file khác vào data thì tính toán số tồn kho thực tế đưa vào bên phải hay ở đâu đó tuỳ bạn. Sao phải nhất thiết là ghi số tồn kho đó vào file data rồi lấy ngược ra lại?
Nhấp chuột vào đây để mở rộng...
Bởi vì trên file Data có Sheet Nhập và xuất thì mới tính được hàng tồn và Tiền lãi còn File chương trình thì không có ( nó chỉ thực hiện lưu mọi cái vào File Data thôi khi cần thì lấy lên..)

Vì vậy mình bắt buột phải chạy Sub Auto_Open trong file Data để cho nó tính toán nhiều cái khác liên Quan nữa (File Data mình úp lên đã xóa đi rất nhiều code trong đó và Sheet..)

Mọi cái từ File chương trình khi cần thì lấy dữ liệu từ File Data lên...
 
Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Thì chỉ việc ghi data nhập hoặc xuất vào file data để lưu trữ, sau khi nhập hoặc xuất = 1 file khác vào data thì tính toán số tồn kho thực tế đưa vào bên phải hay ở đâu đó tuỳ bạn. Sao phải nhất thiết là ghi số tồn kho đó vào file data rồi lấy ngược ra lại?
Nhấp chuột vào đây để mở rộng...

Hi, GPE mình được cái thằng sheet dễ tính, bảo làm gì nó cũng làm. Bảo về An Giang cấy lúa nó cũng về, bảo về Sài Gòn trông thóc nó cũng nghe, bảo về giúp vợ Hai Lúa thổi cơm nó cũng ừ. Hai Lúa lo phòng bếp phụ nha kẻo có ngày nửa cơm nửa thóc.
Đùa chút thôi, anh em mình sao cứ thích thằng data ra tính tính trình bày. Nó vừa loằng ngoằng, lòe loẹt khó khai thác và nguy hiểm đến sự an toàn của dữ liệu. Trong khi có thể lấy tất cả những gì nó có ra muốn làm gì thì làm.
 
Upvote 0
kieu manh đã viết:
Bởi vì trên file Data có Sheet Nhập và xuất thì mới tính được hàng tồn còn File chương trình thì không có ( nó chỉ thực hiện lưu mọi cái vào File Data thôi khi cần thì lấy lên..)

Vì vậy mình bắt buột phải chạy Sub Auto_Open trong file Data để cho nó tính toán nhiều cái khác liên Quan nữa (File Data mình úp lên đã xóa đi rất nhiều code trong đó và Sheet..)

Mọi cái từ File chương trình khi cần thì lấy dữ liệu từ File Data lên...
Nhấp chuột vào đây để mở rộng...
Tôi đã diễn đạt ở trên mà bạn không đọc kỹ, có nghĩa là:
File data chỉ dùng để lưu nhập và xuất. Ta ở 1 file khác (file chuongtrinh) truy vấn vào file data, tính toán số nhập và xuất để lấy kết quả ra file chuongtrinh. Đâu cần tính tồn kho ở file data đâu bạn. Không ai làm thế đâu. Như vậy trong file data chỉ có lưu 1 sheet là sheet nhập + xuất, hoặc bạn có thể tách làm 2, tuy nhiên theo tôi thì nên gom 2 sheet nhập và xuất vào 1 sheet. Trong file chương trình sẽ là file xử lý dữ liệu.
 
Lần chỉnh sửa cuối:
Upvote 0
sealand đã viết:
Hi, GPE mình được cái thằng sheet dễ tính, bảo làm gì nó cũng làm. Bảo về An Giang cấy lúa nó cũng về, bảo về Sài Gòn trông thóc nó cũng nghe, bảo về giúp vợ Hai Lúa thổi cơm nó cũng ừ. Hai Lúa lo phòng bếp phụ nha kẻo có ngày nửa cơm nửa thóc.
Đùa chút thôi, anh em mình sao cứ thích thằng data ra tính tính trình bày. Nó vừa loằng ngoằng, lòe loẹt khó khai thác và nguy hiểm đến sự an toàn của dữ liệu. Trong khi có thể lấy tất cả những gì nó có ra muốn làm gì thì làm.
Nhấp chuột vào đây để mở rộng...
Nếu dữ liệu lớn và nhiều người dùng thì nên đi theo hướng này anh à, để sau này dể chuyển đổi từ excel data sang những csdl khác nếu có nhu cầu.
 
Upvote 0
Đây là bài học cho việc tham gia trên GPE, không ai dám phủ định kiến thức và công lao của Doveandrose nhưng chỉ vì theo yêu cầu của người hỏi về cách làm mà chưa tìm hiểu về cách làm đã phù hợp chưa. Nhất là Topic này còn phát triển thì cách làm này còn sa đà. Mình cũng từng bị thế này rồi nên trước khi trả lời mình thường xem qua còn cách nào ngon hơn không. Giúp nhau thì giúp cho trót phải không?
Nếu dữ liệu lớn và nhiều người dùng thì nên đi theo hướng này anh à, để sau này dể chuyển đổi từ excel data sang những csdl khác nếu có nhu cầu.
Nhấp chuột vào đây để mở rộng...

Rất đúng nếu sau chuyển sang Access chẳng hạn, chỉ cần Link cái Data là ngon. Để mấy ô tính toán thì đố Access biết là cái gì? Mặt khác, Exc chưa thấy được gọi là Exc data đâu nha, nó chỉ là dạng bảng tính linh hoạt và data cũng chỉ là anh em mình ngầm hiểu với nhau thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Tôi đã diễn đạt ở trên mà bạn không đọc kỹ, có nghĩa là:
File data chỉ dùng để lưu nhập và xuất. Ta ở 1 file khác (file chuongtrinh) truy vấn vào file data, tính toán số nhập và xuất để lấy kết quả ra file chuongtrinh. Đâu cần tính tồn kho ở file data đâu bạn. Không ai làm thế đâu. Như vậy trong file data chỉ có lưu 1 sheet là sheet nhập + xuất, hoặc bạn có thể tách làm 2, tuy nhiên theo tôi thì nên gom 2 sheet nhập và xuất vào 1 sheet. Trong file chương trình sẽ là file xử lý dữ liệu.
Nhấp chuột vào đây để mở rộng...
ý đó mình thấy hơi khó để mình tính lại xem....
Nhưng ý của mình là File Data lưu mọi cái vào đó ... xử lý hết ở đó....Còn File Chương Trình thì thao tác lưu và lấy dữ liệu đã xử lý lên thôi....
 
Upvote 0
sealand đã viết:
Đây là bài học cho việc tham gia trên GPE, không ai dám phủ định kiến thức và công lao của Doveandrose nhưng chỉ vì theo yêu cầu của người hỏi về cách làm mà chưa tìm hiểu về cách làm đã phù hợp chưa. Nhất là Topic này còn phát triển thì cách làm này còn sa đà. Mình cũng từng bị thế này rồi nên trước khi trả lời mình thường xem qua còn cách nào ngon hơn không. Giúp nhau thì giúp cho trót phải không?
Nhấp chuột vào đây để mở rộng...
Code Doveandrose Viết rất hay vượt qua khả năng vận dụng và hiểu biết của mình....
Cảm ơn Bạn Hiền rất nhiều.... 1 năm nữa mình sẽ hiểu hết code đó
 
Upvote 0
sealand đã viết:
Đây là bài học cho việc tham gia trên GPE, không ai dám phủ định kiến thức và công lao của Doveandrose nhưng chỉ vì theo yêu cầu của người hỏi về cách làm mà chưa tìm hiểu về cách làm đã phù hợp chưa. Nhất là Topic này còn phát triển thì cách làm này còn sa đà. Mình cũng từng bị thế này rồi nên trước khi trả lời mình thường xem qua còn cách nào ngon hơn không. Giúp nhau thì giúp cho trót phải không?
Nhấp chuột vào đây để mở rộng...

anh nặng lời rồi . giúp người khác theo cách nào đó là tùy vào tính tình mỗi người
tôi không có thói quen tham gia ý kiến về cách người dùng xây dựng CSDL của họ
tôi dễ lắm . thích xôi cho ăn xôi . còn khi nào cảm thấy code không được tôi bỏ chạy trước
đoạn code ở trên có gì đáng để gọi là công lao ? đối với tôi viết những đoạn như thế quá dễ
@Kiều Mạnh : góp ý của anh Hai Lúa Miền Tây làm cho công việc gọn hơn nhiều đấy . anh nên cân nhắc
 
Upvote 0
kieu manh đã viết:
ý đó mình thấy hơi khó để mình tính lại xem....
Nhưng ý của mình là File Data lưu mọi cái vào đó ... xử lý hết ở đó....Còn File Chương Trình thì thao tác lưu và lấy dữ liệu đã xử lý lên thôi....
Nhấp chuột vào đây để mở rộng...
Nếu mọi cái làm ở Data thì chắc chắn 1 điều là CSDL sẽ bị phìn to, code sẽ bị ì ịch. Tôi chỉ góp ý thế còn việc bạn vận dụng theo cách nào thì tùy bạn thôi.
 
Upvote 0
Tôi chỉ làm ví dụ để chứng minh việc tôi gợi ý cho bạn ở trên.

Tạo chuổi kết nối khi mở file chuongtrinh:

Mã: 
Option Explicit

Private Sub Workbook_Open()
Sheet1.Range("A1") = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
               ThisWorkbook.Path & "\data.xlsb" & _
              ";extended properties=""Excel 12.0;hdr=no"";"
End Sub
Trong file chương trình tôi tạo 1 module mới như sau:
Mã: 
Option Explicit

Dim cnn As Object, rst As Object
'Code ghi du lieu hang ban vao file data
Sub Ghi_Xuat_DuLieu()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    cnn.Execute ("insert into [Data_Ban$] select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J] where F3 is not null")
    Lay_TonKho
End Sub
'Code tong hop nhap xuat ton tu file data
Sub Tong_Nhap_Xuat_Ton()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    Set rst = cnn.Execute("select F2, sum(F3), Sum(F6),Sum(F12),Sum(F13),sum(F3)-sum(F12) from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
    Sheet2.Range("a2").CopyFromRecordset rst
    
End Sub
'Code lay so luong ton kho tu file data
Sub Lay_TonKho()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    Set rst = cnn.Execute("select F2, sum(F3)-sum(F12) from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
    Sheet1.Range("M6").CopyFromRecordset rst
    
End Sub

Bạn xem ví dụ nhé.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
doveandrose đã viết:
anh nặng lời rồi . giúp người khác theo cách nào đó là tùy vào tính tình mỗi người
tôi không có thói quen tham gia ý kiến về cách người dùng xây dựng CSDL của họ
tôi dễ lắm . thích xôi cho ăn xôi . còn khi nào cảm thấy code không được tôi bỏ chạy trước
đoạn code ở trên có gì đáng để gọi là công lao ? đối với tôi viết những đoạn như thế quá dễ
@Kiều Mạnh : góp ý của anh Hai Lúa Miền Tây làm cho công việc gọn hơn nhiều đấy . anh nên cân nhắc
Nhấp chuột vào đây để mở rộng...

Tập trung vào chuyên môn đi !!! Ý tôi là trước khi tham gia cũng nên xem xét tránh cả 2 đều chui vào đường cụt không ngờ thôi. Làm gì có chuyện nặng nhẹ mà cứ toáng lên nhỉ, anh em ai giúp được nhau là tốt rồi.
Giờ xem code của HaiLuaMT thấy nó ổn và nó mở cho mình hàng tỷ code trên file chuong trình tùy ý chứ. Có phải dùng tất đâu, làm đến đâu lôi ra đến đấy. Những cái này mình dùng phần mềm kế toán thấy dân IT họ viết quá khoa học và chỉn chu nên nhiều lần tham gia với anh em nên tham khảo. Một ý nữa mình cũng đã nhiều lần tham gia với anh em, Exc chỉ là Data (CSDL) nghiệp dư mà thôi, muốn nó khỏe , chơi được với thiên hạ thì phải bảo nó học theo dân chuyên nghiệp.
Chỉ vậy thôi nha đừng nói chi thêm việc ý tứ.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Tôi chỉ làm ví dụ để chứng minh việc tôi gợi ý cho bạn ở trên.

Tạo chuổi kết nối khi mở file chuongtrinh:

Mã: 
Option Explicit

Private Sub Workbook_Open()
Sheet1.Range("A1") = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
               ThisWorkbook.Path & "\data.xlsb" & _
              ";extended properties=""Excel 12.0;hdr=no"";"
End Sub
Trong file chương trình tôi tạo 1 module mới như sau:
Mã: 
Option Explicit

Dim cnn As Object, rst As Object
'Code ghi du lieu hang ban vao file data
Sub Ghi_Xuat_DuLieu()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    cnn.Execute ("insert into [Data_Ban$] select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J] where F3 is not null")
    Lay_TonKho
End Sub
'Code tong hop nhap xuat ton tu file data
Sub Tong_Nhap_Xuat_Ton()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    Set rst = cnn.Execute("select F2, sum(F3), Sum(F6),Sum(F12),Sum(F13),sum(F3)-sum(F12) from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
    Sheet2.Range("a2").CopyFromRecordset rst
    
End Sub
'Code lay so luong ton kho tu file data
Sub Lay_TonKho()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    Set rst = cnn.Execute("select F2, sum(F3)-sum(F12) from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
    Sheet1.Range("M6").CopyFromRecordset rst
    
End Sub

Bạn xem ví dụ nhé.
Nhấp chuột vào đây để mở rộng...
Vậy là quá OK ........Từ đó mình muốn làm gì thì làm
Còn một chút nữa nhờ Bạn Xử lý cho
Khi lấy hàng tồn lên thì Sắp Xếp tên Hàng cố định theo Cột B để mình Tiện kiểm soát và theo dõi
File kèm
 

File đính kèm

Upvote 0
kieu manh đã viết:
Vậy là quá OK ........Từ đó mình muốn làm gì thì làm
Còn một chút nữa nhờ Bạn Xử lý cho
Khi lấy hàng tồn lên thì Sắp Xếp tên Hàng cố định theo Cột B để mình Tiện kiểm soát và theo dõi
File kèm
Nhấp chuột vào đây để mở rộng...
Theo tôi được biết thì ADO sẽ không làm được việc đó, nó chỉ sort dữ liệu theo dạng chuẩn. Nếu như theo ý bạn thì tôi nghĩ chỉ có cách là dùng update kết quả sang thôi.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Theo tôi được biết thì ADO sẽ không làm được việc đó, nó chỉ sort dữ liệu theo dạng chuẩn. Nếu như theo ý bạn thì tôi nghĩ chỉ có cách là dùng update kết quả sang thôi.
Nhấp chuột vào đây để mở rộng...
Vậy thì nó Copy tên cột [B6:B82] qua ... xong Rồi Update số lượng theo tên hàng đó được không
Mong bạn giúp dùm
xin cảm ơn
 
Upvote 0
kieu manh đã viết:
Vậy thì nó Copy tên cột [B6:B82] qua ... xong Rồi Update số lượng theo tên hàng đó được không
Mong bạn giúp dùm
xin cảm ơn
Nhấp chuột vào đây để mở rộng...
Chỉnh lại code khi mở workbook

Mã: 
Option Explicit

Private Sub Workbook_Open()


    Sheet1.Range("A1") = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
                   ThisWorkbook.Path & "\data.xlsb" & _
                  ";extended properties=""Excel 12.0;hdr=no"";"
    Sheet1.Range("A2") = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
                   ThisWorkbook.FullName & _
                  ";extended properties=""Excel 12.0;hdr=no"";"
End Sub

Trong module

Mã: 
Option Explicit

Dim cnn As Object, rst As Object


'Code ghi du lieu hang ban vao file data
Sub Ghi_Xuat_DuLieu()


    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    cnn.Execute ("insert into [Data_Ban$] select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J] where F3 is not null")
    Lay_TonKho
End Sub
'Code tong hop nhap xuat ton tu file data
Sub Tong_Nhap_Xuat_Ton()


    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    Set rst = cnn.Execute("select F2, sum(F3), Sum(F6),Sum(F12),Sum(F13),sum(F3)-sum(F12) from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
    Sheet2.Range("a2").CopyFromRecordset rst
    
End Sub
'Code lay so luong ton kho tu file data
Sub Lay_TonKho()


    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Open (Sheet1.Range("A1"))
        Set rst = .Execute("select F2, sum(F3)-sum(F12) from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
        Sheet1.Range("M6").CopyFromRecordset rst
        .Close
        .Open (Sheet1.Range("A2"))
        .Execute ("UPDATE [BanHang$M6:N] a INNER JOIN [BanHang$A6:K] b ON a.F1=b.F2  SET b.F11=a.F2")
    End With
End Sub

Xem thêm file đính kèm.
 

File đính kèm

Upvote 0
lấy hàng Tồn lên Gán vào Cột K là chính xác Theo cột B rồi đó ..sao Không Gán qua Cột N và cột M là tên hàng giống cột B
 
Upvote 0
kieu manh đã viết:
lấy hàng Tồn lên Gán vào Cột K là chính xác Theo cột B rồi đó ..sao Không Gán qua Cột N và cột M là tên hàng giống cột B
Nhấp chuột vào đây để mở rộng...
Sau này bạn có thể tự tìm được câu trả lời này, với trình độ cùi bắp của tôi không chắc giải thích được.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Sau này bạn có thể tự tìm được câu trả lời này, với trình độ cùi bắp của tôi không chắc giải thích được.
Nhấp chuột vào đây để mở rộng...
Mình xử lý bằng cách cực kỳ Cùi bắp là ....
PHP: 
Sub Lay_TonKho()
    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Open (Sheet1.Range("A1"))
        Set rst = .Execute("select F2, sum(F3)-sum(F12) from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
        Sheet1.Range("M6").CopyFromRecordset rst
        .Close
        .Open (Sheet1.Range("A2"))
       .Execute ("UPDATE [BanHang$M6:N] a INNER JOIN [BanHang$A6:K] b ON a.F1=b.F2  SET b.F11=a.F2")
    End With     
    Range("M6:M82").Value = Range("B6:B82").Value
    Range("N6:N82").Value = Range("K6:K82").Value
    Range("K6:K82").ClearContents
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
kieu manh đã viết:
Mình xử lý bằng cách cực kỳ Cùi bắp là ....
PHP: 
Sub Lay_TonKho()
    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Open (Sheet1.Range("A1"))
        Set rst = .Execute("select F2, sum(F3)-sum(F12) from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
        Sheet1.Range("M6").CopyFromRecordset rst
        .Close
        .Open (Sheet1.Range("A2"))
       .Execute ("UPDATE [BanHang$M6:N] a INNER JOIN [BanHang$A6:K] b ON a.F1=b.F2  SET b.F11=a.F2")
    End With     
    Range("M6:M82").Value = Range("B6:B82").Value
    Range("N6:N82").Value = Range("K6:K82").Value
    Range("K6:K82").ClearContents
End Sub
Nhấp chuột vào đây để mở rộng...
Tôi gửi bạn ví dụ về cập nhật trên range để phần nào bạn hiểu được cách thức, bạn tự nghiên cứu và tìm giải pháp tốt hơn nhé.

Mã: 
'Code lay so luong ton kho tu file data

Sub Lay_TonKho()
    Dim strTen As String
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    Set rst = cnn.Execute("select F2, sum(F3)-sum(F12) as F10 from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
    Application.ScreenUpdating = False
    Sheet1.Range("M6").Activate
    Do While Not IsEmpty(ActiveCell)
        strTen = ActiveCell.Value
        rst.Filter = "F2='" & strTen & "'"
        If rst.EOF Then
            rst.Filter = ""
            ActiveCell.Offset(0, 1) = "Khong Co"
        Else
            ActiveCell.Offset(0, 1) = rst("F10").Value
        End If
        ActiveCell.Offset(1, 0).Activate
    Loop
    Application.ScreenUpdating = True
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Tôi gửi bạn ví dụ về cập nhật trên range để phần nào bạn hiểu được cách thức, bạn tự nghiên cứu và tìm giải pháp tốt hơn nhé.

Mã: 
'Code lay so luong ton kho tu file data

Sub Lay_TonKho()
    Dim strTen As String
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    Set rst = cnn.Execute("select F2, sum(F3)-sum(F12) as F10 from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
    Application.ScreenUpdating = False
    Sheet1.Range("M6").Activate
    Do While Not IsEmpty(ActiveCell)
        strTen = ActiveCell.Value
        rst.Filter = "F2='" & strTen & "'"
        If rst.EOF Then
            rst.Filter = ""
            ActiveCell.Offset(0, 1) = "Khong Co"
        Else
            ActiveCell.Offset(0, 1) = rst("F10").Value
        End If
        ActiveCell.Offset(1, 0).Activate
    Loop
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Thay vì viết như vậy thì mình copy Qua File nào cũng chạy được
PHP: 
Sub Ghi_Xuat_DuLieu2()
    Dim Cnn As Object
    Set Cnn = CreateObject("ADODB.Connection")
    Cnn.Open ("provider=Microsoft.ACE.OLEDB.12.0; data source=" & _ 
           ThisWorkbook.Path & "\data.xlsb" & _
            ";extended properties=""Excel 12.0;hdr=no"";")
    Cnn.Execute ("insert into [Data_Ban$A2:J] select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J82] where F3 is not null")
    Set Cnn = Nothing
End Sub
Thì lại viết khó như sau và thêm Private Sub Workbook_Open() làm cho mình mò một hồi cũng ra.....qua mấy Bài viết của bạn hóa cái đầu của mình nó to thêm một tí Về ADO cảm ơn Bạn rất nhiều--=0
PHP: 
Sub Ghi_Xuat_DuLieu()
    Set Cnn = CreateObject("ADODB.Connection")
    Cnn.Open (Sheet1.Range("A1"))
    Cnn.Execute ("insert into [Data_Ban$] select * from [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$A6:J] where F3 is not null")
    End Sub
 
Upvote 0
Có một điều mình mong muốn là cải thiện được tốc độ xử lý .... nhưng cuối cùng tốc lại chậm hơn so với VBA .... tại Sao ?????????

Mà hàng ngày mình bán hàng liên tục phải ghi liên tục ....mà ADO xử lý chậm hơn VBA
các bạn Có thể tải File về Test bấm vào Ghi VBA xong Bấm Ghi ADO chờ kết quả....
Xin cảm Ơn
 

File đính kèm

Upvote 0
kieu manh đã viết:
Có một điều mình mong muốn là cải thiện được tốc độ xử lý .... nhưng cuối cùng tốc lại chậm hơn so với VBA .... tại Sao ?????????

Mà hàng ngày mình bán hàng liên tục phải ghi liên tục ....mà ADO xử lý chậm hơn VBA
các bạn Có thể tải File về Test bấm vào Ghi VBA xong Bấm Ghi ADO chờ kết quả....
Xin cảm Ơn
Nhấp chuột vào đây để mở rộng...

thay Sub Lay_TonKho() cũ bằng Sub này xem mèo nào cắn miu nào ?
Mã: 
Sub Lay_TonKho()
    Dim strTen As String, arr As Variant, r As Long, Dic As Object, dArr As Variant
    Set Cnn = CreateObject("ADODB.Connection")
    Set Dic = CreateObject("Scripting.Dictionary")
    Cnn.Open (Sheet1.Range("A1"))
    Set rst = Cnn.Execute("select f1, sum(f6)-sum(f12) from (select f1,f2 as f6,0 as f12 from [Data_Nhap$B2:C] union all select f1,0 as f6,f2 as f12 from [Data_Ban$B2:C]) group by f1 ")
    dArr = rst.GetRows
    Application.ScreenUpdating = False
    arr = Sheet1.Range("M6:M" & Sheet1.[M6].End(xlDown).Row).Value
    For r = 0 To UBound(dArr, 2) Step 1
        Dic(dArr(0, r)) = dArr(1, r)
    Next
    For r = 1 To UBound(arr) Step 1
        If Dic.exists(arr(r, 1)) Then
            arr(r, 1) = Dic(arr(r, 1))
        Else
            arr(r, 1) = "khong co dau Kieu Manh oi"
        End If
    Next
    Sheet1.Range("N6:N" & Sheet1.[M6].End(xlDown).Row).Value = arr
    Application.ScreenUpdating = True
    Set Cnn = Nothing
    Set rst = Nothing
End Sub
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Tôi gửi bạn ví dụ về cập nhật trên range để phần nào bạn hiểu được cách thức, bạn tự nghiên cứu và tìm giải pháp tốt hơn nhé.

Mã: 
'Code lay so luong ton kho tu file data

Sub Lay_TonKho()
    Dim strTen As String
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet1.Range("A1"))
    Set rst = cnn.Execute("select F2, sum(F3)-sum(F12) as F10 from (select F2,F3,F6,0 as F12 ,0 as F13 from [Data_Nhap$] union all select F2,0,0,F3,F6 from [Data_Ban$]) group by F2 ")
    Application.ScreenUpdating = False
    Sheet1.Range("M6").Activate
    Do While Not IsEmpty(ActiveCell)
        strTen = ActiveCell.Value
        rst.Filter = "F2='" & strTen & "'"
        If rst.EOF Then
            rst.Filter = ""
            ActiveCell.Offset(0, 1) = "Khong Co"
        Else
            ActiveCell.Offset(0, 1) = rst("F10").Value
        End If
        ActiveCell.Offset(1, 0).Activate
    Loop
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Như tôi nói ở trên, tôi chỉ đưa ra ví dụ để hiểu cách thức vận dụng.

kieu manh đã viết:
Có một điều mình mong muốn là cải thiện được tốc độ xử lý .... nhưng cuối cùng tốc lại chậm hơn so với VBA .... tại Sao ?????????

Mà hàng ngày mình bán hàng liên tục phải ghi liên tục ....mà ADO xử lý chậm hơn VBA
các bạn Có thể tải File về Test bấm vào Ghi VBA xong Bấm Ghi ADO chờ kết quả....
Xin cảm Ơn
Nhấp chuột vào đây để mở rộng...
Không hẳn thề đâu? Bạn nên cải biến nó nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
cách trên của mình vẫn chưa đạt vì còn sử dụng mấy cái ngoài ADO . sub này sửa lại sử dụng ADO 100 %
Mã: 
Sub Lay_TonKho()
    Dim strTen As String
    Set Cnn = CreateObject("ADODB.Connection")
    Cnn.Open (Sheet1.Range("A1"))
    Set rst = Cnn.Execute("select iif(a.f24 is null,0,a.f24) " & _
    "from (select f1, sum(f6)-sum(f12) as f24 from " & _
    "(select f1,f2 as f6,0 as f12 from [Data_Nhap$B2:C] " & _
    "union all select f1,0 as f6,f2 as f12 from [Data_Ban$B2:C]) group by f1) a " & _
    "right join [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$M6:M] b on a.f1 = b.f1")
    Application.ScreenUpdating = False
    Sheet1.Range("N6").CopyFromRecordset rst
    Application.ScreenUpdating = True
    Set Cnn = Nothing
    Set rst = Nothing
End Sub
 
Upvote 0
doveandrose đã viết:
cách trên của mình vẫn chưa đạt vì còn sử dụng mấy cái ngoài ADO . sub này sửa lại sử dụng ADO 100 %
Mã: 
Sub Lay_TonKho()
    Dim strTen As String
    Set Cnn = CreateObject("ADODB.Connection")
    Cnn.Open (Sheet1.Range("A1"))
    Set rst = Cnn.Execute("select iif(a.f24 is null,0,a.f24) " & _
    "from (select f1, sum(f6)-sum(f12) as f24 from " & _
    "(select f1,f2 as f6,0 as f12 from [Data_Nhap$B2:C] " & _
    "union all select f1,0 as f6,f2 as f12 from [Data_Ban$B2:C]) group by f1) a " & _
    "right join [" & ThisWorkbook.FullName & ";hdr=no].[BanHang$M6:M] b on a.f1 = b.f1")
    Application.ScreenUpdating = False
    Sheet1.Range("N6").CopyFromRecordset rst
    Application.ScreenUpdating = True
    Set Cnn = Nothing
    Set rst = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Hãy tối ưu thêm nữa, vẫn còn vài chổ chưa được như ý.
 
Upvote 0
doveandrose đã viết:
anh làm mẫu luôn đi để em học tập với . sức em có vậy à
Nhấp chuột vào đây để mở rộng...
Gợi ý chút, hiện tại cái list dựa vào cột M, nếu cột M không có dữ liệu thì sao? Câu hỏi đặt ra là không cần cột M mà vẫn đưa ra dữ liệu cột M và N.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Gợi ý chút, hiện tại cái list dựa vào cột M, nếu cột M không có dữ liệu thì sao? Câu hỏi đặt ra là không cần cột M mà vẫn đưa ra dữ liệu cột M và N.
Nhấp chuột vào đây để mở rộng...

ủa vậy là sao anh ? cột M Kiều Mạnh định nghĩa là cột làm mẫu về thứ tự và được copy từ cột B sang . như thế câu hỏi nếu như cột M không có dữ liệu là sao ? Kiều Mạnh đâu có ý định xóa cột M ?
 
Upvote 0
doveandrose đã viết:
ủa vậy là sao anh ? cột M Kiều Mạnh định nghĩa là cột làm mẫu về thứ tự và được copy từ cột B sang . như thế câu hỏi nếu như cột M không có dữ liệu là sao ? Kiều Mạnh đâu có ý định xóa cột M ?
Nhấp chuột vào đây để mở rộng...
Đừng nóng, cái chuyện copy là chuyện của người ta. Theo yêu cầu của tác giả đến đây là ok, tuy nhiên giả sử cột M không có thì sao? Ta làm cách nào để được dữ liệu như tác giả yêu cầu?
 
Upvote 0
doveandrose đã viết:
ủa vậy là sao anh ? cột M Kiều Mạnh định nghĩa là cột làm mẫu về thứ tự và được copy từ cột B sang . như thế câu hỏi nếu như cột M không có dữ liệu là sao ? Kiều Mạnh đâu có ý định xóa cột M ?
Nhấp chuột vào đây để mở rộng...
Thay vì nhìn từ cột B qua cũng được nhưng để lại Cột M nhìn kế Bên là Cột N thì dễ coi hơn
Càng về Sau code càng Xúc tích ngắn gọn mà Hay.......Cảm ơn Các Bạn nhiều .....khi nào rãnh qua Bình dương gọi cho Mạnh ta làm vài xị nha....Tel: 0929.555.666
sao code sau không viết thành một Function mà phải viết vậy thành ra mình cứ phải sửa lại Vì
[A1] là mình viết tên của hàng....ADO mình kém lắm Viết Function là thua
PHP: 
Private Sub Workbook_Open()
    Sheet1.Range("A1") = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
                   ThisWorkbook.Path & "\data.xlsb" & _ 
                 ";extended properties=""Excel 12.0;hdr=no"";"    
Sheet1.Range("A2") = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
                   ThisWorkbook.FullName & _
                  ";extended properties=""Excel 12.0;hdr=no"";"
End Sub
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Đừng nóng, cái chuyện copy là chuyện của người ta. Theo yêu cầu của tác giả đến đây là ok, tuy nhiên giả sử cột M không có thì sao? Ta làm cách nào để được dữ liệu như tác giả yêu cầu?
Nhấp chuột vào đây để mở rộng...

không cho right join đến [BanHang$M6:M] thì right join đến [BanHang$B6:B] . nhưng chắc đây không phải ý anh . anh có thể nói rõ hơn không ?
 
Upvote 0
Upvote 0
kieu manh đã viết:
Thay vì nhìn từ cột B qua cũng được nhưng để lại Cột M nhìn kế Bên là Cột N thì dễ coi hơn
Càng về Sau code càng Xúc tích ngắn gọn mà Hay.......Cảm ơn Các Bạn nhiều .....khi nào rãnh qua Bình dương gọi cho Mạnh ta làm vài xị nha....Tel: 0929.555.666
sao code sau không viết thành một Function mà phải viết vậy thành ra mình cứ phải sửa lại Vì
[A1] là mình viết tên của hàng....ADO mình kém lắm Viết Function là thua
PHP: 
Private Sub Workbook_Open()
    Sheet1.Range("A1") = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
                   ThisWorkbook.Path & "\data.xlsb" & _ 
                 ";extended properties=""Excel 12.0;hdr=no"";"    
Sheet1.Range("A2") = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & _
                   ThisWorkbook.FullName & _
                  ";extended properties=""Excel 12.0;hdr=no"";"
End Sub
Nhấp chuột vào đây để mở rộng...
Có thể ghi vào chổ nào cũng được, tùy biến thôi mà bạn. Tôi chỉ ví dụ, bạn nên vận dụng để dể nhớ nhé.
 
Upvote 0
Upvote 0
Phần bán hàng như vậy là quá tốt rồi....còn Phần Nhập-Xuất-Tồn nó chưa đồng Bộ với Phần Bán hàng vậy mình úp mẫu lên nhờ các bạn trợ giúp

1/ Sheet Nhập-Xuất-Tồn cột tên hàng luôn luôn cập nhật theo cột của sheet BanHang

2/ Tính toán dùm mình theo Mẫu Sheet Nhap-Xuat-Ton (vẫn lấy nguồn Từ File Data)....trong File data viết Bằng VBA thì Mình làm được ...còn ADO lấy lên tính toán thì không làm được ... vậy nhờ các Bạn xử lý dùm

Xin Cảm ơn
 

File đính kèm

Upvote 0
doveandrose đã viết:
thì nãy giờ em nêu 2 cách rồi mà
phải làm sao mới xí dụ được anh cho học hỏi 1 đoạn code đây . hức . khó quá /-*+//-*+//-*+/
Nhấp chuột vào đây để mở rộng...
ecec, từ đầu đến giờ tôi có viết được code nào ra hồn đâu. Bạn viết không đó chứ, nghe đồn anh Ba Tê "ngon" cái vụ "xí dụ" lắm. Bạn liên hệ ảnh xem sao nhé. ecec....
 
Upvote 0
doveandrose đã viết:
thay Sub Lay_TonKho() cũ bằng Sub này xem mèo nào cắn miu nào ?
Mã: 
Sub Lay_TonKho()
    Dim strTen As String, arr As Variant, r As Long, Dic As Object, dArr As Variant
    Set Cnn = CreateObject("ADODB.Connection")
    Set Dic = CreateObject("Scripting.Dictionary")
    Cnn.Open (Sheet1.Range("A1"))
    Set rst = Cnn.Execute("select f1, sum(f6)-sum(f12) from (select f1,f2 as f6,0 as f12 from [Data_Nhap$B2:C] union all select f1,0 as f6,f2 as f12 from [Data_Ban$B2:C]) group by f1 ")
    dArr = rst.GetRows
    Application.ScreenUpdating = False
    arr = Sheet1.Range("M6:M" & Sheet1.[M6].End(xlDown).Row).Value
    For r = 0 To UBound(dArr, 2) Step 1
        Dic(dArr(0, r)) = dArr(1, r)
    Next
    For r = 1 To UBound(arr) Step 1
        If Dic.exists(arr(r, 1)) Then
            arr(r, 1) = Dic(arr(r, 1))
        Else
            arr(r, 1) = "khong co dau Kieu Manh oi"
        End If
    Next
    Sheet1.Range("N6:N" & Sheet1.[M6].End(xlDown).Row).Value = arr
    Application.ScreenUpdating = True
    Set Cnn = Nothing
    Set rst = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Code bài Này Bạn Viết hay quá ..dùng ADO lấy lên xong Add vào mãng Dic... Kết hợp ADO và Dic Tuyệt Vời
Mình Sửa lại một Tẹo như sau cho Phù hợp với mình
PHP: 
Sub Lay_TonKho22()
    Dim strTen As String, arr As Variant, r As Long, Dic As Object, dArr As Variant
    Set Cnn = CreateObject("ADODB.Connection")
    Set Dic = CreateObject("Scripting.Dictionary")
    Cnn.Open (Sheet1.Range("XFD1"))
    Set rst = Cnn.Execute("select f1, sum(f6)-sum(f12) from (select f1,f2 as f6,0 as f12 from [Data_Nhap$B2:C] union all select f1,0 as f6,f2 as f12 from [Data_Ban$B2:C]) group by f1 ")
    dArr = rst.GetRows
    Application.ScreenUpdating = False
    arr = Sheet1.Range("B6:B82").Value
    For r = 0 To UBound(dArr, 2) Step 1
        Dic(dArr(0, r)) = dArr(1, r)
    Next
    For r = 1 To UBound(arr) Step 1
        If Dic.exists(arr(r, 1)) Then
            arr(r, 1) = Dic(arr(r, 1))
        Else
            arr(r, 1) = Empty
        End If
    Next
    Sheet1.Range("N6:N82").Value = arr
    Application.ScreenUpdating = True
    Set Cnn = Nothing
    Set rst = Nothing
End Sub
 
Upvote 0
kieu manh đã viết:
Code bài Này Bạn Viết hay quá ..dùng ADO lấy lên xong Add vào mãng Dic... Kết hợp ADO và Dic Tuyệt Vời
Mình Sửa lại một Tẹo như sau cho Phù hợp với mình
PHP: 
Sub Lay_TonKho22()
    Dim strTen As String, arr As Variant, r As Long, Dic As Object, dArr As Variant
    Set Cnn = CreateObject("ADODB.Connection")
    Set Dic = CreateObject("Scripting.Dictionary")
    Cnn.Open (Sheet1.Range("XFD1"))
    Set rst = Cnn.Execute("select f1, sum(f6)-sum(f12) from (select f1,f2 as f6,0 as f12 from [Data_Nhap$B2:C] union all select f1,0 as f6,f2 as f12 from [Data_Ban$B2:C]) group by f1 ")
    dArr = rst.GetRows
    Application.ScreenUpdating = False
    arr = Sheet1.Range("B6:B82").Value
    For r = 0 To UBound(dArr, 2) Step 1
        Dic(dArr(0, r)) = dArr(1, r)
    Next
    For r = 1 To UBound(arr) Step 1
        If Dic.exists(arr(r, 1)) Then
            arr(r, 1) = Dic(arr(r, 1))
        Else
            arr(r, 1) = Empty
        End If
    Next
    Sheet1.Range("N6:N82").Value = arr
    Application.ScreenUpdating = True
    Set Cnn = Nothing
    Set rst = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Theo mình thì:
1. Khai báo kiểu Early Binding (tức là check vào mục Reference) cho code chạy nhanh hơn. Khai báo cũng gọn hơn, khỏi mắc công set này set nọ.
2. Nếu muốn dùng VBA xử lý thì sao không dùng phương thức Getrows lấy tất tần tật lên mảng rồi xử lý, mắc chi phải dùng câu lệnh SQL phức tạp kia làm gì. Chú ý cái mảng sau khi lấy bằng GetRows là mảng ngược nhé.
3. Mình chỉ đoán vậy thôi, nên nếu có trật thì mọi người bỏ qua nhé.
 
Upvote 0
quanghai1969 đã viết:
Theo mình thì:
1. Khai báo kiểu Early Binding (tức là check vào mục Reference) cho code chạy nhanh hơn. Khai báo cũng gọn hơn, khỏi mắc công set này set nọ.
2. Nếu muốn dùng VBA xử lý thì sao không dùng phương thức Getrows lấy tất tần tật lên mảng rồi xử lý, mắc chi phải dùng câu lệnh SQL phức tạp kia làm gì. Chú ý cái mảng sau khi lấy bằng GetRows là mảng ngược nhé.
3. Mình chỉ đoán vậy thôi, nên nếu có trật thì mọi người bỏ qua nhé.
Nhấp chuột vào đây để mở rộng...
Em làm gì có khả năng viết được như Anh nói... có chăng 1 -2 năm nữa may ra viết được
Em thấy chạy ok sửa lại một tẹo cho phù hợp thôi mà
 
Upvote 0
Tham gia 1 code cho vui, chứ thật sự không dám ho hen với ADO. Chú ý là phải dùng Early Binding nha. Không check vào running time hoặc không check vào data object* gì đó thì code nó ngu nhá.
*** Lâu rồi không tung chưởng nào hết. Bận quá rồi code cũng biến đi mất. Có chỗ nào không hay thì mọi người góp ý nhé.
PHP: 
Sub Main()
Dim SQL As String, MySheet(), Tmp(), i As Long, j As Long, Arr()
Dim ObjRst As New ADODB.Recordset, ObjConn As New ADODB.Connection, Dic As New dictionary
MySheet = Array("[Data_Nhap$B2:C65536]", "[Data_Ban$B2:C65536]")
Set ObjConn = GetConnection(ThisWorkbook.Path & "\Data.xlsb")
For j = 0 To UBound(MySheet)
   SQL = "select * from " & MySheet(j)
   ObjRst.Open SQL, ObjConn, 3, 1
   Tmp = ObjRst.GetRows
   ObjRst.Close
   GetData Tmp, Dic, j
Next
With Sheets("BanHang")
   Arr = .Range("M6", .[M65536].End(3)).Resize(, 2).Value
End With
For i = 1 To UBound(Arr)
   If Dic.Exists(Arr(i, 1)) Then
      Arr(i, 2) = Dic.Item(Arr(i, 1))
   Else
      Arr(i, 2) = Empty
   End If
Next
Sheets("BanHang").[M6].Resize(i - 1, 2) = Arr
End Sub
PHP: 
Sub GetData(Arr, Dic, j)
Dim i As Long
For i = 0 To UBound(Arr, 2)
   If j = 0 Then
      Dic(Arr(0, i)) = Dic(Arr(0, i)) + Arr(1, i)
   Else
      Dic(Arr(0, i)) = Dic(Arr(0, i)) - Arr(1, i)
   End If
Next
End Sub
PHP: 
Function GetConnection(ByVal Path As String)
Dim StrConn As String, ObjConn As New ADODB.Connection
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" _
& Path & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
ObjConn.Open StrConn
Set GetConnection = ObjConn
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
quanghai1969 đã viết:
Tham gia 1 code cho vui, chứ thật sự không dám ho hen với ADO. Chú ý là phải dùng Early Binding nha. Không check vào running time hoặc không check vào data object* gì đó thì code nó ngu nhá.
*** Lâu rồi không tung chưởng nào hết. Bận quá rồi code cũng biến đi mất. Có chỗ nào không hay thì mọi người góp ý nhé.
PHP: 
Sub Main()
Dim SQL As String, MySheet(), Tmp(), i As Long, j As Long, Arr()
Dim ObjRst As New ADODB.Recordset, ObjConn As New ADODB.Connection, Dic As New dictionary
MySheet = Array("[Data_Nhap$B2:C65536]", "[Data_Ban$B2:C65536]")
Set ObjConn = GetConnection(ThisWorkbook.Path & "\Data.xlsb")
For j = 0 To UBound(MySheet)
   SQL = "select * from " & MySheet(j)
   ObjRst.Open SQL, ObjConn, 3, 1
   Tmp = ObjRst.GetRows
   ObjRst.Close
   GetData Tmp, Dic, j
Next
With Sheets("BanHang")
   Arr = .Range("M6", .[M65536].End(3)).Resize(, 2).Value
End With
For i = 1 To UBound(Arr)
   If Dic.Exists(Arr(i, 1)) Then
      Arr(i, 2) = Dic.Item(Arr(i, 1))
   Else
      Arr(i, 2) = Empty
   End If
Next
Sheets("BanHang").[M6].Resize(i - 1, 2) = Arr
End Sub
PHP: 
Sub GetData(Arr, Dic, j)
Dim i As Long
For i = 0 To UBound(Arr, 2)
   If j = 0 Then
      Dic(Arr(0, i)) = Dic(Arr(0, i)) + Arr(1, i)
   Else
      Dic(Arr(0, i)) = Dic(Arr(0, i)) - Arr(1, i)
   End If
Next
End Sub
PHP: 
Function GetConnection(ByVal Path As String)
Dim StrConn As String, ObjConn As New ADODB.Connection
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" _
& Path & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
ObjConn.Open StrConn
Set GetConnection = ObjConn
End Function
Nhấp chuột vào đây để mở rộng...
chạy tốt đó anh ... nhưng phải Check Runtime Và Data Object .. nó mới chạy
Kỳ này Anh viết ADO siêu thật
 
Lần chỉnh sửa cuối:
Upvote 0
Góp vui (Chỉ góp vui thôi nha, ngoài ra không có đóng góp gì khác cả) --=0
 

File đính kèm

Upvote 0
kieu manh đã viết:
Em đọc tới lui code Anh viết ... khúc biết khúc không...... coi như không biết .........Ngu quá../-*+//-*+/
Nhấp chuột vào đây để mở rộng...

Sửa lại vầy xem coi có dễ hiểu hơn không.
PHP: 
Sub Main()
Dim SQL As String, MySheet(), Tmp(), i As Long, j As Long, Arr()
Dim ObjRst As New ADODB.Recordset, ObjConn As New ADODB.Connection, Dic As New dictionary
MySheet = Array("Data_Nhap$", "Data_Ban$")
Set ObjConn = GetConnection(ThisWorkbook.Path & "\Data.xlsb")
For j = 0 To UBound(MySheet)
   SQL = "select * from [" & MySheet(j) & "B2:C65536]"
   ObjRst.Open SQL, ObjConn, 3, 1
   Tmp = ObjRst.GetRows
   ObjRst.Close
   GetData Tmp, Dic, j
Next
With Sheets("BanHang")
   Arr = .Range("M6", .[M65536].End(3)).Resize(, 2).Value
End With
Final Arr, Dic
Sheets("BanHang").[M6].Resize(UBound(Arr), 2) = Arr
End Sub
PHP: 
Sub GetData(Arr, Dic, j)
Dim i As Long, n As Long
For i = 0 To UBound(Arr, 2)
   n = IIf(j = 0, 1, -1)
   Dic(Arr(0, i)) = Dic(Arr(0, i)) + (Arr(1, i) * n)
Next
End Sub
PHP: 
Sub Final(Arr, Dic)
Dim i As Long
For i = 1 To UBound(Arr)
   If Dic.Exists(Arr(i, 1)) Then
      Arr(i, 2) = Dic.Item(Arr(i, 1))
   Else
      Arr(i, 2) = Empty
   End If
Next
End Sub
PHP: 
Function GetConnection(ByVal Path As String)
Dim StrConn As String, ObjConn As New ADODB.Connection
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" _
& Path & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
ObjConn.Open StrConn
Set GetConnection = ObjConn
End Function
 
Upvote 0
quanghai1969 đã viết:
Sửa lại vầy xem coi có dễ hiểu hơn không.
PHP: 
Sub Main()
Dim SQL As String, MySheet(), Tmp(), i As Long, j As Long, Arr()
Dim ObjRst As New ADODB.Recordset, ObjConn As New ADODB.Connection, Dic As New dictionary
MySheet = Array("Data_Nhap$", "Data_Ban$")
Set ObjConn = GetConnection(ThisWorkbook.Path & "\Data.xlsb")
For j = 0 To UBound(MySheet)
   SQL = "select * from [" & MySheet(j) & "B2:C65536]"
   ObjRst.Open SQL, ObjConn, 3, 1
   Tmp = ObjRst.GetRows
   ObjRst.Close
   GetData Tmp, Dic, j
Next
With Sheets("BanHang")
   Arr = .Range("M6", .[M65536].End(3)).Resize(, 2).Value
End With
Final Arr, Dic
Sheets("BanHang").[M6].Resize(UBound(Arr), 2) = Arr
End Sub
PHP: 
Sub GetData(Arr, Dic, j)
Dim i As Long, n As Long
For i = 0 To UBound(Arr, 2)
   n = IIf(j = 0, 1, -1)
   Dic(Arr(0, i)) = Dic(Arr(0, i)) + (Arr(1, i) * n)
Next
End Sub
PHP: 
Sub Final(Arr, Dic)
Dim i As Long
For i = 1 To UBound(Arr)
   If Dic.Exists(Arr(i, 1)) Then
      Arr(i, 2) = Dic.Item(Arr(i, 1))
   Else
      Arr(i, 2) = Empty
   End If
Next
End Sub
PHP: 
Function GetConnection(ByVal Path As String)
Dim StrConn As String, ObjConn As New ADODB.Connection
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" _
& Path & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
ObjConn.Open StrConn
Set GetConnection = ObjConn
End Function
Nhấp chuột vào đây để mở rộng...
Vẫn chưa khắc phục như bài #57
​
tôi đã đề cập.

Tôi chuyển những câu truy vấn ra ngoài sheet (Sheet3). Vẫn chưa vừa ý lắm, còn nhiều chổ cần phải cải tiến.

Code khi mở file:

Mã: 
Option Explicit

Private Sub Workbook_Open()


    Sheet3.Range("B1") = ThisWorkbook.Path & "\"
    Sheet3.Range("B3") = ThisWorkbook.Name
End Sub

Code trong module

Mã: 
Option Explicit

Dim cnn As Object, rst As Object


'Code ghi du lieu hang ban vao file data
Sub Ghi_Xuat_DuLieu()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet3.Range("B4"))
    cnn.Execute (Sheet3.Range("B16"))
    Lay_TonKho
End Sub
'Code tong hop nhap xuat ton tu file data
Sub Tong_Nhap_Xuat_Ton()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet3.Range("B4"))
    Set rst = cnn.Execute(Sheet3.Range("B14"))
    Sheet2.Range("a2").CopyFromRecordset rst
End Sub
'Code lay so luong ton kho tu file data


Sub Lay_TonKho()
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open (Sheet3.Range("B4"))
    Set rst = cnn.Execute("select F1, Ton from (" & Sheet3.Range("B12") & ")")
    Sheet1.Range("M6").CopyFromRecordset rst
End Sub

Ví dụ ở file đính kèm.
 

File đính kèm

Upvote 0
Hai Lúa Miền Tây đã viết:
Vậy phải coi dữ liệu của bạn thế nào đã, thường thì ta dùng hàm Val
Nhấp chuột vào đây để mở rộng...
Mình thấy xài Hàm sau của Bạn thấy cũng được .... có hay hơn xài hàm Val không..
PHP: 
Function TransArr(Sarr As Variant) As Variant
    Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmpArr As Variant
    On Error Resume Next
    tmpX = UBound(Sarr, 2):    tmpY = UBound(Sarr, 1)
    ReDim tmpArr(1 To tmpX + 1, 1 To tmpY + 1)
    For cllX = 0 To tmpX
        For cllY = 0 To tmpY
            tmpArr(cllX + 1, cllY + 1) = Sarr(cllY, cllX)
        Next cllY
    Next cllX
    TransArr = tmpArr
End Function
 
Upvote 0
kieu manh đã viết:
Mình thấy xài Hàm sau của Bạn thấy cũng được .... có hay hơn xài hàm Val không..
PHP: 
Function TransArr(Sarr As Variant) As Variant
    Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmpArr As Variant
    On Error Resume Next
    tmpX = UBound(Sarr, 2):    tmpY = UBound(Sarr, 1)
    ReDim tmpArr(1 To tmpX + 1, 1 To tmpY + 1)
    For cllX = 0 To tmpX
        For cllY = 0 To tmpY
            tmpArr(cllX + 1, cllY + 1) = Sarr(cllY, cllX)
        Next cllY
    Next cllX
    TransArr = tmpArr
End Function
Nhấp chuột vào đây để mở rộng...

đã cố gắng suy nghĩ nhưng vẫn không hiểu Kiều Mạnh muốn làm gì . hic
 
Upvote 0
doveandrose đã viết:
đã cố gắng suy nghĩ nhưng vẫn không hiểu Kiều Mạnh muốn làm gì . hic
Nhấp chuột vào đây để mở rộng...
Tại vì trước đây mình cũng mê ADO lắm ...Copy mấy Code trên GPE về chỉnh lại theo ý mình xài thấy ok....một ngày đẹp trời máy hỏng cài lại win ... vẫn code đó chạy thấy lỗi không cộng lại được (dữ liệu chuyên text) . khả năng mình chưa làm chủ được ADo ghét bỏ luôn...

sau này thử Hàm đó chuyển lấy dữ liệu Từ ADo lên Nguon = TransArr(RS.GetRows)thì xài OK...vậy đó
 
Upvote 0
Các bác cho hỏi với file DATA của bác Kieu Manh mà để trên máy chủ, còn các nhân viên thì sử dụng file Chuongtrinh trên các máy desktop (1 file data, nhiều file chương trình) thì việc ghi và xuất dữ liệu tới file Data này có được không, nhất là phương án ghi bằng ADO.?
 
Upvote 0
andythuy đã viết:
Các bác cho hỏi với file DATA của bác Kieu Manh mà để trên máy chủ, còn các nhân viên thì sử dụng file Chuongtrinh trên các máy desktop (1 file data, nhiều file chương trình) thì việc ghi và xuất dữ liệu tới file Data này có được không, nhất là phương án ghi bằng ADO.?
Nhấp chuột vào đây để mở rộng...
Nên chuyển sang database là access.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL (2 người xem)
Trả lời
2
Đọc
79
danhpheo
D
H
Đánh số thự theo lượt (2 người xem)
Trả lời
0
Đọc
24
hongminh_0306
H
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên (1 người xem)
    • Cảm ơn
Trả lời
2
Đọc
83
phuongnam366377
phuongnam366377
A
  • Question Question
Copy 2 form sang file khác, có 1 form Show, 1 form không Show (1 người xem)
Trả lời
2
Đọc
65
AnhThu-1976
A
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ.
Trả lời
5
Đọc
131
truc.duong87
T
H
Tự động cập nhật dữ liệu từ 2 file word
Trả lời
1
Đọc
85
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới. (1 người xem)
Trả lời
7
Đọc
258
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter
Trả lời
8
Đọc
136
eagle12
E
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
436
Đọc
57K
hangiang
H
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống
Trả lời
1
Đọc
3K
aFdangthacmac
A
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
8
Đọc
384
ongke0711
ongke0711
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
9K
Hoale85
H
Nam168
Không mở được file excel
Trả lời
2
Đọc
81
Nam168
Nam168
V
Quản lý xuất nhập vật tư trong kho
Trả lời
14
Đọc
551
LOGANWover
L
phuongnam366377
Sử dụng COM DLL **không cần đăng ký** với Delphi 12 / C++ Builder
    • Thích
Trả lời
0
Đọc
102
phuongnam366377
phuongnam366377
N
Định mức nguyên vật liệu
Trả lời
49
Đọc
5K
ntan50
N
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
6
Đọc
304
Chả_biết_gì
C
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
26
Đọc
1K
haitien123
H
ongke0711
Truy cập trang GPE chậm
    • Thích
Trả lời
3
Đọc
214
Hai Lúa Miền Tây
Hai Lúa Miền Tây
V
Gộp File Từng File Excel vào 1 File
Trả lời
16
Đọc
518
ptm0412
ptm0412
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom