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

8 Responses

1. hands says:

   31/01/2023 at 4:01 pm

   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.

   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 [URL="https://www.giaiphapexcel.com/forum/member.php?u=189279"%5Ddoveandrose 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

   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ớ.

   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

   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 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

   2806

   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?

   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…

   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.

   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.

   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.

   Đâ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.

   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.

   Reply
2. hands says:

   31/01/2023 at 4:04 pm

   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.

   ý đó 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….

   Đâ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?

   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 đó

   ý đó 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….

   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.

   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:

   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:

   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é.

   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

   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.

   Vậy thì nó Copy tên cột 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

   Chỉnh lại code khi mở workbook

   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

   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.

   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

   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.

   Mình xử lý bằng cách cực kỳ Cùi bắp là ….

   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

   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é.

   '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

   Thay vì viết như vậy thì mình copy Qua File nào cũng chạy được

   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 .[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

   Sub Ghi_Xuat_DuLieu()
   Set Cnn = CreateObject("ADODB.Connection")
   Cnn.Open (Sheet1.Range("A1"))
   Cnn.Execute ("insert into [Data_Ban$] select * from .[BanHang$A6:J] where F3 is not null")
   End Sub

   Reply
3. hands says:

   31/01/2023 at 4:05 pm

   Đâ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?

   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

   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ứ.

   Reply
4. hands says:

   31/01/2023 at 4:09 pm

   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

   thay Sub Lay_TonKho() cũ bằng Sub này xem mèo nào cắn miu nào ?

   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

   Reply
5. hands says:

   31/01/2023 at 4:14 pm

   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 %

   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

   Hãy tối ưu thêm nữa, vẫn còn vài chổ chưa được như ý.

   anh làm mẫu luôn đi để em học tập với . sức em có vậy à

   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.

   ủ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 ?

   Đừ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?

   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 ?

   Hãy thử đến mọi trường hợp. Đó cũng là 1 cách.

   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ì
   là mình viết tên của hàng….ADO mình kém lắm Viết Function là thua

   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

   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é.

   có phải ý anh là dùng lệnh Update bảng chăng ?

   Mấu chốt nằm ở chổ cột B sheet BanHang.
   Còn rất nhiều cách để xử vụ này, bạn hãy thử cho đến khi tạm gọi là "ngon" nhé.

   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á /-*+//-*+//-*+/

   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….

   Reply
6. hands says:

   31/01/2023 at 4:14 pm

   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

   thay Sub Lay_TonKho() cũ bằng Sub này xem mèo nào cắn miu nào ?

   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

   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

   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

   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é.

   Em làm gì có khả năng viết được như Anh @quanghai1969 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à

   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é.

   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", ..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")..Resize(i – 1, 2) = Arr
   End Sub

   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

   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

   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

   Bài 71 có nói rõ mà. Nếu không check vào 2 mục đó thì code nó sẽ ngu ngu.

   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á../-*+//-*+/

   Sửa lại vầy xem coi có dễ hiểu hơn không.

   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", ..End(3)).Resize(, 2).Value
   End With
   Final Arr, Dic
   Sheets("BanHang")..Resize(UBound(Arr), 2) = Arr
   End Sub

   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

   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

   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

   Reply
7. hands says:

   31/01/2023 at 4:20 pm

   Góp vui (Chỉ góp vui thôi nha, ngoài ra không có đóng góp gì khác cả) –=0

   Khiếp mã hóa vậy @huuthang_bd ……….Nhìn thấy chạy mất dép………./-*+//-*+//-*+/
   Phải nói là GPE nhân tài kiệt xuất như lá mùa thu ……….nhưng ít khi lộ bài…

   Câu "nhân tài kiệt xuất như lá mùa thu" nghe.. buồn cười sao ấy

   Hổng biết có ai hiểu không? –=0

   Reply
8. hands says:

   31/01/2023 at 4:24 pm

   Vẫn chưa khắc phục như bài [URL="https://www.giaiphapexcel.com/forum/showthread.php?107950-Ghi-D%E1%BB%AF-Li%E1%BB%87u-V%C3%A0o-File-%C4%90%C3%B3ng-B%E1%BA%B1ng-ADO&p=673161#post673161"%5D#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:

   Option Explicit
   
   Private Sub Workbook_Open()
   
   Sheet3.Range("B1") = ThisWorkbook.Path & ""
       Sheet3.Range("B3") = ThisWorkbook.Name
   End Sub

   Code trong module

   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.

   Mọi người có thể chỉ cho mình hàm convert từ text sang số trong truy vấn SQL với. Cám ơn các bạn

   Vậy phải coi dữ liệu của bạn thế nào đã, thường thì ta dùng hàm Val

   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..

   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

   đã cố gắng suy nghĩ nhưng vẫn không hiểu Kiều Mạnh muốn làm gì . hic

   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 đó

   Cám ơn bạn mình làm được rùi.
   Mà truy vấn trên Excel là dựa trên truy vấn Access. Vậy nó có thể áp dụng sử dụng truy vấn crosstab query không.

   Hoàn toàn có thể được bạn à.

   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.?

   Nên chuyển sang database là access.

   Reply