Giới hạn ADO query bảng dữ liệu

[NGOCTOAN]

Kính gửi các Anh Chị GPE,
Em có 1 Sheet1 chứa dữ liệu các loại thuốc đã kê khai giá lên tới gần 200.000 dòng, em có dùng ADO VBA để tra cứu theo tên thuốc nhưng khi tra cứu chỉ lấy được trong phạm vi 70.000 dòng còn lại các record ngoài phạm vi trên không dc ADO query.
Vậy có cách nào để truy vấn đến 200.000 dòng để lấy đủ số liệu cần tìm ko ạ. Em có gửi file mẫu kèm có 1 vaì chục dòng để giảm kích thước.
Xin cảm ơn các Anh Chị GPE.
Ngoctoan.

 

[Hai Lúa Miền Tây]

Kính gửi các Anh Chị GPE,
Em có 1 Sheet1 chứa dữ liệu các loại thuốc đã kê khai giá lên tới gần 200.000 dòng, em có dùng ADO VBA để tra cứu theo tên thuốc nhưng khi tra cứu chỉ lấy được trong phạm vi 70.000 dòng còn lại các record ngoài phạm vi trên không dc ADO query.
1. Vậy có cách nào để truy vấn đến 200.000 dòng để lấy đủ số liệu cần tìm ko ạ.
2. Em có gửi file mẫu kèm có 1 vaì chục dòng để giảm kích thước.
Xin cảm ơn các Anh Chị GPE.
Ngoctoan.

1. Thay query sau của bạn:

SELECT f1,f2,f3,f4,f5
FROM [data$A2:S]
WHERE Lcase(f4) like '%5mg%'

Thành:

SELECT f1,f2,f3,f4,f5
FROM [data$]
WHERE Lcase(f4) like '%5mg%'

2. Bạn xóa dữ liệu và để vài chục dòng? Sau này nên xóa luôn dữ liệu dư thừa bên dưới của Table1 nhé.

 

[NGOCTOAN]

1. Thay query sau của bạn:

SELECT f1,f2,f3,f4,f5
FROM [data$A2:S]
WHERE Lcase(f4) like '%5mg%'

Thành:

SELECT f1,f2,f3,f4,f5
FROM [data$]
WHERE Lcase(f4) like '%5mg%'

2. Bạn xóa dữ liệu và để vài chục dòng? Sau này nên xóa luôn dữ liệu dư thừa bên dưới của Table1 nhé.

Anh HLMT cho em hỏi thêm : code anh sửa bảng dữ liệu chạy rất ok trên Ex 2016 nhưng chạy trên Ex2013 cứ báo lỗi :

và Debug ở chỗ này ạ:

Mong anh xem hộ có phải hàm này chỉ chạy trên excel 2016 không ạ
Cảm ơn Anh nhiều.

 

[Hai Lúa Miền Tây]

Anh HLMT cho em hỏi thêm : code anh sửa bảng dữ liệu chạy rất ok trên Ex 2016 nhưng chạy trên Ex2013 cứ báo lỗi :
View attachment 203822
và Debug ở chỗ này ạ:
View attachment 203823
Mong anh xem hộ có phải hàm này chỉ chạy trên excel 2016 không ạ
Cảm ơn Anh nhiều.

Ngộ thế bạn? Bạn test thử như sau coi được không nhé

Sheet4.Range("A6").CopyFromRecordset cn.Execute(Sheet4.Range("A3"))

 

[NGOCTOAN]

Ngộ thế bạn? Bạn test thử như sau coi được không nhé

Sheet4.Range("A6").CopyFromRecordset cn.Execute(Sheet4.Range("A3"))

Em thử như cách Anh HLMT nhưng vẫn báo lỗi như cũ, không biết có phải khai báo thêm gì không trên ex2013 trở về trước.

Cảm ơn Anh đã hướng dẫn.
Ngoctoan

 

[Vô danh Tiểu tốt]

Mình chạy file đầu tiên của bạn trên Office 2010, Windows 7 64bit, không có vấn đề gì cả trừ việc phải sửa Sheet4.[A4] thành Sheet4.[A3].
Mà sao

rst.MoveLast
Debug.Print rst.RecordCount

lại luôn ra -1 nhỉ?

 

[NGOCTOAN]

Mình chạy file đầu tiên của bạn trên Office 2010, Windows 7 64bit, không có vấn đề gì cả trừ việc phải sửa Sheet4.[A4] thành Sheet4.[A3].
Mà sao

rst.MoveLast
Debug.Print rst.RecordCount

lại luôn ra -1 nhỉ?

Không biết có phải là vì em chạy Ex2016 64bit ok nhưng sang Ex2013 32bit thì báo lỗi như đã nếu, Anh Vô Danh Tiểu tốt chạy Ex2010 64 hay 32 ạ. còn Win ko quan trọng thì phải.
Ngoctoan.

 

[Vô danh Tiểu tốt]

Mình 32bit

 

[NGOCTOAN]

Mình 32bit

Thực tế, file trên ex2016 64bit em save as về dang x2003 file phình to gấp 3 lần nhưng khi cho sang office 2007 ->2013 32 bit ko có lỗi gì cả. EM nghi lôi là do làm trên ex2016 64bit nên chạy office 32 nó bị lỗi vậy. Nhưng số dòng data table bị cắt đi chỉ con 65563 dòng thôi.

 

[Hai Lúa Miền Tây]

Mình chạy file đầu tiên của bạn trên Office 2010, Windows 7 64bit, không có vấn đề gì cả trừ việc phải sửa Sheet4.[A4] thành Sheet4.[A3].
Mà sao

rst.MoveLast
Debug.Print rst.RecordCount

lại luôn ra -1 nhỉ?

Thử chạy code sau coi có gì khác biệt không nhé:

Sub tinh_tong()
    Dim cn As Object, rst As Object
    Set cn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    If Val(Application.Version) < 12 Then
        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=""Excel 8.0;HDR=No;"""
    Else
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=""Excel 12.0;HDR=No;"""
    End If
    With Sheet4
        rst.Open ("SELECT f1,f2,f3,f4,f5 FROM [data$] WHERE Lcase(f4) like '%5mg%'"), cn, 1
        .Range("a8:S65536").Clear
        .Range("A8").CopyFromRecordset rst
        .Select
        Debug.Print rst.RecordCount
    End With

End Sub

 

[Vô danh Tiểu tốt]

Hai Lúa Miền Tây hay nhỉ? Mình có tét một đoạn tương tự trước rồi nhưng mà không chạy được kết quả như bạn

    'Dim cn As Object
    Dim cn As New ADODB.Connection
    'Dim rst As Object
    Dim rst As New ADODB.Recordset
    'Set cn = CreateObject("ADODB.Connection")
    'Set cn = CreateObject("ADODB.Connection")
    With Sheet1
        If Val(Application.Version) < 12 Then
            cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & _
                    ";Extended Properties=""Excel 8.0;HDR=No;"""
        Else
            cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
                    ";Extended Properties=""Excel 12.0;HDR=No;"""
        End If
   
    With rst
        .ActiveConnection = cn
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Source = Sheet4.Range("A3")
        .Open
    End With
    rst.MoveFirst
    rst.MoveLast
    Debug.Print rst.RecordCount

Thay bằng khai báo kiểu này

    Dim cn As Object
    'Dim cn As New ADODB.Connection
    Dim rst As Object
    'Dim rst As New ADODB.Recordset
    Set cn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

cũng bị. hehe