Bài tập về ADO căn bản.

Liên hệ QC
trong thủ tục này
PHP:
With cnn
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                "Data Source=" & ThisWorkbook.Path & "\DM_A.xls" & _
                                ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
            .Open
      lsSQL1 = "SELECT MSDM, TENCV, DVTINH, VL, NC, MXD " & _
      "FROM [DG_A$] " '& _
       "WHERE [MHDM] = '" & Cells(3, 2) & "' "      'DG_A ten sheet can lay du lieu
      lrs1.Open lsSQL1, cnn, 3, 1

có thể dùng thêm COS có được không <LẤY DỮ LIỆU Ở NHIỀU BẢNG TÍNH>

With cnnA
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                "Data Source=" & ThisWorkbook.Path & "\DM_B.xls" & _
                                ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
            .Open
       End With 
     lsSQL2 = "SELECT MSDM, TENCV " & _
      "FROM [DG_B$] " '& _
       "WHERE [MHDM] = '" & Cells(3, 2) & "' "      'DG_B ten sheet can lay du lieu
      lrs2.Open lsSQL2, cnn, 3, 1
vì mình muốn lấy dữ liệu ở nhiều bảng tính đang đóng để lọc theo điều kiện cần tìm
nhờ các bạn giải quyết giúp mình
có cách nào hay và rút gọn lại được không
!$@!!
 
nhờ AE diễn đàn GE gỡ rối cho mục này

PHP:
Sub LayDL_ADO17() 
     Dim lsSQL As String, cnn As Object, lrs As Object 
     Dim sh As Worksheet 
     Dim lr As Long, j As Long, m As Long, k As Long, n As Long 
           Dim Arr As Variant, ExcelArr As Variant, i As Long, _            
                  c As Long, h As Long, r As Long, v As Long 
     Set cnn = CreateObject("ADODB.Connection") 
     Set lrs = CreateObject("ADODB.Recordset") 
     Set sh = Sheet5 
     n = 1 
     m = 7 
     lr = sh.Range("G" & Rows.Count).End(xlUp).Row 
               
     With cnn .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
                            "Data Source=" & ThisWorkbook.Path & "\DM.xls" & _ 
                             ";Extended Properties=""Excel 8.0;HDR=Yes;"";" 
           .Open 
     End With 
       For j = 7 To lr 
           If sh.Cells(j, 7) = "" Then 
                  Cells(m, 1) = n 
                  Cells(m, 2) = sh.Cells(j + 1, 7).Value 
           Else 
                  Cells(m, 1) = n 
                  Cells(m, 2) = sh.Cells(j, 7).Value 
 
lsSQL = "SELECT MSVT, HPVT, MA_NC " & _ 
         "FROM [DM$] " & _ 
         "WHERE [MHDM] = '" & Cells(m, 2) & "' " 

 lrs.Open lsSQL, cnn, 3, 1
       
      Arr = lrs.GetRows

        v = UBound(Arr, 1) + 1 
       h = UBound(Arr, 2) + 1 
   ReDim ExcelArr(1 To h, 1 To v): r = 0 
     For i = 1 To h 
         r = r + 1 
           For c = 1 To v 
               ExcelArr(r, c) = Arr(c - 1, i - 1) 
           Next c 
     Next i 
           Sheet5.Range("C" & m+1).Resize(h, v).Value = ExcelArr 

           k = sh.Range("C" & Rows.Count).End(xlUp).Row 
           m = k + 1 
           n = n + 1
 
     lrs.Close: Set lrs = Nothing 
     cnn.Close: Set cnn = Nothing 

     End If 
 Next j
End Sub

=>> khi chạy lấy dữ liệu thì chỉ được 1 vòng lặp còn chuyển sang vong 2 thì cos bị lỗi
lrs.Open lsSQL, cnn, 3, 1
kèm theo thông báo
Run - time error '3705 '
operation is not allowed when the object is open
 
Lần chỉnh sửa cuối:
Connection closed mất rồi.
 
chuyển ra ngoài for vẫn bị lỗi lrs.Open lsSQL, cnn, 3, 1
PHP:
Sub LayDL_ADO17()

For j = 7 To lr 
      
     If sh.Cells(j, 7) = "" Then

        <khối lệnh>  

lrs.Open lsSQL, cnn, 3, 1


 End If 

Next j 
      'chuyển ra ngoài for vẫn lỗi  lrs.Open lsSQL, cnn, 3, 1
lrs.Close: Set lrs = Nothing      
cnn.Close: Set cnn = Nothing


End Sub
 
' lô gic đơn giản
open connection
for...
open recordset
...
close recordset
next
close connection
set all objects to nothing
 
MÌNH ĐÃ LÀM ĐƯỢC RỒI
CHO COS NÀY VÀO TRONG FOR
PHP:
      Set cnn = CreateObject("ADODB.Connection")

      Set lrs = CreateObject("ADODB.Recordset")

             With cnn

            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _

                                "Data Source=" & ThisWorkbook.Path & "\DienBien2012\DMDB1776.xls" & _

                                ";Extended Properties=""Excel 8.0;HDR=Yes;"";"


           .Open

      End With
mình vừa học trên diễn đàn nên ko biết nhiều
THANKS CÁC BẠN ĐÃ GIÚP
 
Hy vọng người ta chừa mình ra.

đương nhiên là chừa anh Vetmini ra rồi , vì bài #363 và #365 chả dính dáng gì đến cách làm đã được chọn ở #366 cả , như 2 đường thẳng song song không có điểm chung vậy +-+-+-++-+-+-+

Theo em nghĩ thì đây là dạng truy vấn khi thỏa mãn giá trị nằm trong 1 tập (Select where column_name IN (,,) ) . Vậy thì cách làm duyệt vòng lặp qua các giá trị trong tập rồi gọi lệnh truy vấn (Select where column_name = '') có vẻ không hay nhỉ ? **~****~**
 
Cái ADO mà Excel dùng nó quản lý bộ nhớ hơi kém. Kết nối vài lượt là có khả năng bị tràn bộ nhớ. Nhất là khi kết nối với chính file chạy code.
Vì vậy rất ít khi ngừoi ta dùng vòng lặp để truy vấn nhiều lần.
 
Các bạn có cách nào hay hơn không
vì theo mình thì cứ sau mỗi lần duyệt nhớ 1 vòng là đóng nhớ và giải phóng nhớ
thì sẽ không tràn nhớ

PHP:
for 
  if
      Arr = Empty
      ExcelArr = Empty
      Set sh = Nothing
      
      lrs.Close: Set lrs = Nothing
      cnn.Close: Set cnn = Nothing      
   End If  

Next j

       'MsgBox "Done in " & Int(Timer - startTime) & " s."

Mình thấy tốc độ hơi chậm 3 s cho 6 dữ liệu điều kiện
khi mình mở vào file nguồn thì không mở được các bạn chỉ giúp hộ
các bạn có cách nào hay không chỉ cho mình với !$@!!
 
Lần chỉnh sửa cuối:
ODEDB có quản lý riêng của chúng. VBA gọi một ADO Object ra làm việc chứ đâu có nắm được code của ADO bao giờ. Khi ADO nhận lệnh close thì nó đồng ý flag là close thôi chứ nó có hứa nhả bộ nhớ ra ngay lập tức đâu. Khi nào nó thấy thuận tiện thì nó nhả.
 
Lần chỉnh sửa cuối:
Lọc các tên theo danh sách và Tính tổng

Chào Anh
Em mượn File cùa anh,em muốn lọc tất cà tên theo danh sách thay vì điều kiện or.
Trường hợp 2 lọc duy nhất và tính tổng.
 

File đính kèm

  • CopyDuLieu.rar
    25 KB · Đọc: 21
Chào Anh
Em mượn File cùa anh,em muốn lọc tất cà tên theo danh sách thay vì điều kiện or.
Trường hợp 2 lọc duy nhất và tính tổng.

Code sẽ như sau nhé bạn (Data trong cùng WB)

[GPECODE=sql]

Sub LocDuyNhat()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[I2].CopyFromRecordset .Execute("Select distinct TEN From [Sheet1$B1:B12]")
End With
End Sub


Sub Tinh_Tong()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Sheet1$B1:C12] Group By Ten")
End With
End Sub


[/GPECODE]
 
Code sẽ như sau nhé bạn (Data trong cùng WB)

[GPECODE=sql]

Sub LocDuyNhat()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[I2].CopyFromRecordset .Execute("Select distinct TEN From [Sheet1$B1:B12]")
End With
End Sub


Sub Tinh_Tong()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Sheet1$B1:C12] Group By Ten")
End With
End Sub

[/GPECODE]
Code này lấy dữ liệu trên file B em muốn cập nhật dữ liệu trên file A
Em muốn 2 trường hơp sau:
1.Lấy tất cả dữ liệu file A theo điều kiện ở cột I mà không tính tổng
2.Lấy tất cả dữ liệu file A theo điều kiện ở cột I và tính tổng
Anh viết lại dùm em nha.
Em Cám ơn Anh rất nhiều.
 
Lần chỉnh sửa cuối:
Code này lấy dữ liệu trên file B em muốn cập nhật dữ liệu trên file A
Em muốn 2 trường hơp sau:
1.Lấy tất cả dữ liệu file A theo điều kiện ở cột I mà không tính tổng
2.Lấy tất cả dữ liệu file A theo điều kiện ở cột I và tính tổng
Anh viết lại dùm em nha.
Em Cám ơn Anh rất nhiều.

Bạn chỉnh lại như sau:

[GPECODE=sql]
Sub LocDuyNhat()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
'Neu du lieu la file A.xls trong cung thu muc
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.Path & "\A.xls;Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[I2].CopyFromRecordset .Execute("Select distinct TEN From [Data$]")
'Neu data trong cung WB
'.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
'Sheet1.[I2].CopyFromRecordset .Execute("Select distinct TEN From [Sheet1$B1:B12]")
End With
End Sub


Sub Tinh_Tong()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
'Neu du lieu la file A.xls trong cung thu muc
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.Path & "\A.xls;Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Data$] Group By Ten")
'Neu data trong cung WB
'.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
'Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Sheet1$B1:C12] Group By Ten")
End With
End Sub


[/GPECODE]
 
Bạn chỉnh lại như sau:

[GPECODE=sql]
Sub LocDuyNhat()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
'Neu du lieu la file A.xls trong cung thu muc
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.Path & "\A.xls;Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[I2].CopyFromRecordset .Execute("Select distinct TEN From [Data$]")
'Neu data trong cung WB
'.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
'Sheet1.[I2].CopyFromRecordset .Execute("Select distinct TEN From [Sheet1$B1:B12]")
End With
End Sub


Sub Tinh_Tong()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
'Neu du lieu la file A.xls trong cung thu muc
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.Path & "\A.xls;Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Data$] Group By Ten")
'Neu data trong cung WB
'.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
'Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Sheet1$B1:C12] Group By Ten")
End With
End Sub
[/GPECODE]

Em muốn lọc tất cả danh sách theo điều kiện tại cột I thay vì hàm or cứ mỗi lần thêm điều kiện là bổ sung hàm or tiếp.
Mã:
Private Sub CommandButton1_Click()
Dim lsSQL As String, cnn As Object, lrs As Object
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With cnn
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & ThisWorkbook.Path & "\A.xls" & _
                        ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
    .Open
End With
'lay het du lieu co trong sheet Data o file A.xls
    lsSQL = "SELECT * " & "FROM [Data$]" & _
    "WHERE [COLOR=#ff0000]TEN= '" & Sheet1.Range("I2") & "'or TEN= '" & Sheet1.Range("I3") & "'or TEN = '" & Sheet1.Range("I4") & "'"[/COLOR]
    lrs.Open lsSQL, cnn, 3, 1
With Sheet1
   .[A2:D1000].ClearContents
   .[A2].CopyFromRecordset lrs
End With
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub
 
Em muốn lọc tất cả danh sách theo điều kiện tại cột I thay vì hàm or cứ mỗi lần thêm điều kiện là bổ sung hàm or tiếp.
Mã:
Private Sub CommandButton1_Click()
Dim lsSQL As String, cnn As Object, lrs As Object
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With cnn
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & ThisWorkbook.Path & "\A.xls" & _
                        ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
    .Open
End With
'lay het du lieu co trong sheet Data o file A.xls
    lsSQL = "SELECT * " & "FROM [Data$]" & _
    "WHERE [COLOR=#ff0000]TEN= '" & Sheet1.Range("I2") & "'or TEN= '" & Sheet1.Range("I3") & "'or TEN = '" & Sheet1.Range("I4") & "'"[/COLOR]
    lrs.Open lsSQL, cnn, 3, 1
With Sheet1
   .[A2:D1000].ClearContents
   .[A2].CopyFromRecordset lrs
End With
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Vậy thì dùng code sau nhé:
[GPECODE=sql]
Sub LayDuLieu()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.Path & "\A.xls;Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[O2].CopyFromRecordset .Execute("Select * From [Data$] where ten IN (select TEN from [" & ThisWorkbook.FullName & "].[sheet1$I1:I13])")
End With
End Sub


[/GPECODE]
 
Vậy thì dùng code sau nhé:
[GPECODE=sql]
Sub LayDuLieu()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.Path & "\A.xls;Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet1.[O2].CopyFromRecordset .Execute("Select * From [Data$] where ten IN (select TEN from [" & ThisWorkbook.FullName & "].[sheet1$I1:I13])")
End With
End Sub

[/GPECODE]
Hay quá cám ơn Anh nhiều.
 
Chào Anh
Em làm được lọc dữ liệu theo điều kiện và tính tổng theo code của anh
nhưng em muốn lấy tất cả cột
Em không upload file được bị phần mềm "Cyberoam"của Cty chặn
Em upload link fshare.
https://www.fshare.vn/file/T2KF7CV4MKNB
Mã:
Private Sub CommandButton1_Click()
Dim v As String
Sheet1.Range("O2:R1000").ClearContents
    v = Application.Version
    With CreateObject("ADODB.Connection")
    '--------------------------------------------------------------------------------------
     'Neu du lieu la file A.xls trong cung thu muc
    '.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & _
    '";Data Source=" & ThisWorkbook.Path & "\A.xls;Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
        'Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Data$] Group By Ten")
    '-------------------------------------------------------------------------------------------
     'Neu data trong cung WB
        .Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & _
        ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
        'Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Sheet1$B1:C12] Group By Ten")
[COLOR=#ff0000]        Sheet1.[P2].CopyFromRecordset .Execute("Select STT,TEN,Ghichu, sum(SoLuong) From [Sheet1$B1:C12] where ten IN (select TEN from [" & ThisWorkbook.FullName & "].[sheet1$I1:I13])Group By Ten")[/COLOR]
    End With
End Sub
 
Lần chỉnh sửa cuối:
Chào Anh
Em làm được lọc dữ liệu theo điều kiện và tính tổng theo code của anh
nhưng em muốn lấy tất cả cột
Em không upload file được bị phần mềm "Cyberoam"của Cty chặn
Em upload link fshare.
https://www.fshare.vn/file/OSMID2X83EJ7

Mã:
Private Sub CommandButton1_Click()
Dim v As String
Sheet1.Range("O2:R1000").ClearContents
    v = Application.Version
    With CreateObject("ADODB.Connection")
    '--------------------------------------------------------------------------------------
     'Neu du lieu la file A.xls trong cung thu muc
    '.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & _
    '";Data Source=" & ThisWorkbook.Path & "\A.xls;Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
        'Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Data$] Group By Ten")
    '-------------------------------------------------------------------------------------------
     'Neu data trong cung WB
        .Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & _
        ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
        'Sheet1.[P2].CopyFromRecordset .Execute("Select TEN, sum(SoLuong) From [Sheet1$B1:C12] Group By Ten")
[COLOR=#ff0000]        Sheet1.[P2].CopyFromRecordset .Execute("Select STT,TEN,Ghichu, sum(SoLuong) From [Sheet1$B1:C12] where ten IN (select TEN from [" & ThisWorkbook.FullName & "].[sheet1$I1:I13])Group By Ten")[/COLOR]
    End With
End Sub

Phần group bạn group có 1 trường đó là TEN, trong khi đó cần Group là STT, TEN, GhiChu. Vậy phải sửa lại là Group By STT, TEN, GhiChu
Lưu ý dữ liệu cột STT và ghi chú khi group có đúng yêu cầu hay không. Vì giống nhau nó mới group lại.
 
Web KT
Back
Top Bottom