Khai thác và tùy biến thêm, sửa, xuất file và lấy dữ liệu từ Recordset (2 người xem)

Liên hệ QC

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

Như vậy ngắn gọn hơn chứ anh Hai Lúa
Mã:
Sub Page_HLMT_2()
    With CreateObject("ADODB.Recordset")
        .Open ("Select * from [Sheet1$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
        .pagesize = 20
        While Not .EOF
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(2).CopyFromRecordset .DataSource, .pagesize
        Wend
    End With
End Sub
Nó trở lại giống những bài trên, ý tôi muốn khai thác rộng ra thêm để tùy biến người dùng sử dụng.
 
Như vậy ngắn gọn hơn chứ anh Hai Lúa
Mã:
Sub Page_HLMT_2()
    With CreateObject("ADODB.Recordset")
        .Open ("Select * from [Sheet1$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
        .pagesize = 20
        While Not .EOF
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(2).CopyFromRecordset .DataSource, .pagesize
        Wend
    End With
End Sub
Bài đó anh Hai Lúa trích dẫn bài của OT nên có thể bài đó muốn viết rõ ràng hơn để OT hiểu thêm nên code phải thêm 1 số dòng, OT thấy viết như vậy OT dễ hiểu đc là cột nào đưa xuống cột nào và dựa vào đó có thể tùy biến vào mẫu báo cáo mình muốn hihi.
Cảm ơn Nhattanktnn đã chỉ thêm cho OT thêm một cách để tham khảo ạ.
 
OT đã hiểu ứng dụng như chắc muốn viết thêm dòng tổng cộng thì phải thêm 1 sub bằng VBA thôi ạ chứ chư biết cách thêm trong đoạn code ADO này của Anh, hihi
Đã có vòng lặp rồi thì ta cộng vào thêm thôi em. Anh tạo dòng tổng, còn tổng cộng thì em thử tự thêm vào nhé.

Mã:
Sub Page_HLMT_3()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = !Price
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = lngTotal
        Next
    End With
End Sub
 
Đã có vòng lặp rồi thì ta cộng vào thêm thôi em. Anh tạo dòng tổng, còn tổng cộng thì em thử tự thêm vào nhé.

Mã:
Sub Page_HLMT_3()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = !Price
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = lngTotal
        Next
    End With
End Sub
Ôi cảm ơn anh Hai Lúa nhiều ạ, để OT xem ứng dụng đc vào chỗ nào để OT ứng dụng ạ. Hihi
 
Đã có vòng lặp rồi thì ta cộng vào thêm thôi em. Anh tạo dòng tổng, còn tổng cộng thì em thử tự thêm vào nhé.

Mã:
Sub Page_HLMT_3()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = !Price
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = lngTotal
        Next
    End With
End Sub
Hay đấy ... Mạnh copy ý tưởng viết thành Hàm cho vào SQL thêm tùy biến cho nó phong phú chút
 
Ôi cảm ơn anh Hai Lúa nhiều ạ, để OT xem ứng dụng đc vào chỗ nào để OT ứng dụng ạ. Hihi
Thử như này xem Oanh Thơ:
Mã:
Sub Page_HLMT_2_2() ' Giong sub tren
Dim a As Long, b As Long
    With CreateObject("ADODB.Recordset")
        .Open ("Select * from [Sheet1$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .pagesize = 20
        While Not .EOF
            a = a + 1: If a = .pagecount Then b = .RecordCount - (.pagecount - 1) * .pagesize Else b = .pagesize
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(2).CopyFromRecordset .DataSource, .pagesize
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 2).FormulaR1C1 = "=sum(R[-" & b & "]C:R[-1]C)"
        Wend
    End With
End Sub
 
Thử như này xem Oanh Thơ:
Mã:
Sub Page_HLMT_2_2() ' Giong sub tren
Dim a As Long, b As Long
    With CreateObject("ADODB.Recordset")
        .Open ("Select * from [Sheet1$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .pagesize = 20
        While Not .EOF
            a = a + 1: If a = .pagecount Then b = .RecordCount - (.pagecount - 1) * .pagesize Else b = .pagesize
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(2).CopyFromRecordset .DataSource, .pagesize
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 2).FormulaR1C1 = "=sum(R[-" & b & "]C:R[-1]C)"
        Wend
    End With
End Sub
Cảm ơn bạn Nhattanktnn đã quan tâm, hình như cách này code sẽ nhanh hơn thì phải, OT cảm nhận vậy thôi ạ. hihi
 
Cảm ơn bạn Nhattanktnn đã quan tâm, hình như cách này code sẽ nhanh hơn thì phải, OT cảm nhận vậy thôi ạ. hihi
Mình hổng biết đâu, theo suy nghĩ sao thì làm vậy thôi. Mình đang học hỏi từ bác Hai Lúa mà. Bạn muốn biết nhanh hay chậm thử set timer xem sao
 
Cảm ơn bạn Nhattanktnn đã quan tâm, hình như cách này code sẽ nhanh hơn thì phải, OT cảm nhận vậy thôi ạ. hihi
Dĩ nhiên rồi em, nó không duyệt và ghi từng dòng dữ liệu. Như anh đã nói là anh đưa ra từng phương án và khai thác nó để tùy từng trường hợp mà ta có thể ứng dụng vào bài toán thực tế của mình.
 
Nó trở lại giống những bài trên, ý tôi muốn khai thác rộng ra thêm để tùy biến người dùng sử dụng.
Ví dụ ta định dạng dữ liệu, nối cột, thực hiện phép tính khi đưa xuống sheet như sau:

Rich (BB code):
Sub Page_HLMT_4()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID & " >> " & !Code
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = Format(!Price, "0,#")
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = Format(lngTotal, "0,#")
        Next
    End With
End Sub
 
Ví dụ ta định dạng dữ liệu, nối cột, thực hiện phép tính khi đưa xuống sheet như sau:

Rich (BB code):
Sub Page_HLMT_4()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID & " >> " & !Code
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = Format(!Price, "0,#")
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = Format(lngTotal, "0,#")
        Next
    End With
End Sub
Uây đúng cái OT muốn xử lý từ trong ADO, mọi khi OT hay lấy dữ liệu về sau đó OT mới sử dụng vba để định dạng.
Cảm ơn anh Hai Lúa nhiều ạ
 
Cảm ơn anh @Hai Lúa Miền Tây về bài em viết em đang quan tâm.
Em có nhu cầu đưa dữ liệu ra màn hình. Do dữ liệu dài mà muốn hiển thị đầy đủ nên cần đưa dữ liệu theo cách trôi dần từng dòng lên trên màn hình 1 cách tự động.
Màn hình hiển thị được 10 dòng, lần đầu em đưa 10 record đầu tiên (record 0-9), sau 5s sẽ hiển thị từ record 1 đến 10, sau 5s tiếp theo lại query từ record 2-11, cứ thế cho đến khi hết dữ liệu. (Bản chất 1 muốn trượt dữ liệu 1 cách mượt nhất và trượt tự động thông qua lệnh Application.Ontime)
Qua những bài viết đầu tiên em cũng đã hiểu 1 chút tuy nhiên vẫn còn lúng túng. Anh hướng dẫn giúp tình huống trên nhé.
Cảm ơn anh

Giống vậy không? Nhìn giống gọi tên + số trong bệnh viện :)
Thêm vài đoạn code vô code của bác HLMT là được.

 
Giống 99.1 % rồi anh.

0.9% còn lại là lặp lại từ đầu khi hết 1 lượt. Cứ như vậy cho tới khi tắt điện. :p

À tôi cho ngưng tại muốn giống trong bệnh viện Saint Paul mà tôi thấy :) . Nó hiện tên bệnh nhân chờ trước phòng khám, nó phải hết để người kế tiếp mình là bệnh nhân kế cuối rồi..hehe...
 
À tôi cho ngưng tại muốn giống trong bệnh viện Saint Paul mà tôi thấy :) . Nó hiện tên bệnh nhân chờ trước phòng khám, nó phải hết để người kế tiếp mình là bệnh nhân kế cuối rồi..hehe...
Nó phải lặp lại giống như @befaint nói, vì đâu phải mình dùng nút bấm để chờ đến lượt. Khi chạy đến cuối thì phải quay ngược lại. :D
 
Không phải rồi anh.
Tác giả có cái màn hình treo ở giữa lối đi, hiện chữ thật to, được 10 dòng.
Giờ muốn kết quả chạy trôi trôi theo phương thẳng đứng, trượt từng dòng một theo thời gian. Kiểu như trình diễn PowerPoint, như kiểu đoạn kết thúc bộ phim có chạy nội dung tác giả kịch bản, đạo diễn, diễn viên, kỹ thuật âm thanh/ sánh sáng ấy. :)
Bạn nói đúng ý của mình muốn. Đây là màn hình hiển thị thông tin ở chỗ công cộng
Hiện mình đang làm được như vậy, nhưng theo vài cách rất lòng vòng. Dữ liệu chạy rất giật. (Mình đổ tất cả dữ liệu ra 1 chỗ. Tại chỗ hiển thị, dùng hàm Vlookup, cho code chạy cái lookup value tăng dần để dữ liệu được hiện dần dần).
Cảm ơn bạn
Bài đã được tự động gộp:

Không khéo làm kiểu này chỉ khó chịu cho người dùng hơn và chưa chắc là thời gian đợi ít hơn so với thời gian đổ dữ liệu 1 lần.
Diễn giải của befain đúng ý em muốn.
Cái màn hình này để hiển thị dữ liệu nơi công cộng và code được viết để chạy lặp lại cho đến khi mất điện. Cần sửa dữ liệu, em sửa trên database mà ko cần chạm vào cái màn hình kia.
Bài đã được tự động gộp:

Giống 99.1 % rồi anh.

0.9% còn lại là lặp lại từ đầu khi hết 1 lượt. Cứ như vậy cho tới khi tắt điện. :p
Đúng là giống, nhưng giống có 98% thôi.
1% chưa giống là nó cần lặp lại vô hạn cho đến khi mất điện (khỏi cần hiện cái thông báo xong)
1% còn lại là nó cần quay lại từ đầu ngay khi dòng cuối cùng của màn hình là trống (trong clip có đẩy cả vài dòng trống lên).
Cảm ơn @befaint@ongke0711
 
Lần chỉnh sửa cuối:
1% chưa giống là nó cần lặp lại vô hạn cho đến khi mất điện (khỏi cần hiện cái thông báo xong)
1% còn lại là nó cần quay lại từ đầu ngay khi dòng cuối cùng của màn hình là trống (trong clip có đẩy cả vài dòng trống lên).

:) làm chơi chơi thôi chứ không có làm kỹ như yêu cầu của bạn.
 
Lần chỉnh sửa cuối:
Lấy file mẫu bài số 1, tạo thêm cột 'Running Total' theo code sau:

Rich (BB code):
Sub Page_HLMT_5()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long, lngRunningTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID & " >> " & !Code
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = Format(!Price, "0,#")
                lngRunningTotal = !Price + lngRunningTotal
                Sheet2.Range("E" & i) = Format(lngRunningTotal, "0,#")
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = Format(lngTotal, "0,#")
        Next
    End With
End Sub

Kết quả sẽ như hình sau:

1605320577204.png
 
Lấy file mẫu bài số 1, tạo thêm cột 'Running Total' theo code sau:

Rich (BB code):
Sub Page_HLMT_5()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long, lngRunningTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID & " >> " & !Code
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = Format(!Price, "0,#")
                lngRunningTotal = !Price + lngRunningTotal
                Sheet2.Range("E" & i) = Format(lngRunningTotal, "0,#")
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = Format(lngTotal, "0,#")
        Next
    End With
End Sub

Kết quả sẽ như hình sau:

View attachment 249314
Ahii, cột lũy kế hay quá anh Hai à.
Giả sử gọi cột D trong hình này là đơn giá và thêm cột số lượng vào bảng dữ liệu nguồn thì code sẽ viết thế nào để ra bảng dữ liệu kế quả gồm đầy đủ các cột đơn giá, số lượng và thêm cột thành tiền nữa vậy anh ơi?
 
Ahii, cột lũy kế hay quá anh Hai à.
Giả sử gọi cột D trong hình này là đơn giá và thêm cột số lượng vào bảng dữ liệu nguồn thì code sẽ viết thế nào để ra bảng dữ liệu kế quả gồm đầy đủ các cột đơn giá, số lượng và thêm cột thành tiền nữa vậy anh ơi?
Thì em thêm vào rồi lấy 2 cột đó nhân nhau là ra được kết quả thôi mà em. Thử làm đi, vướng chỗ nào lên đây hỏi nhé.
 
Tiện đây cũng xin hỏi bạn dùng phương pháp nào vậy? Có dùng kỹ thuật ADO hay cách khác ?

Dùng ADO Recordset với phương thức .DataSource như bác HLMT đã giới thiệu.
Code bên dưới chạy như hình gif trong bài post trước của tôi chứ chưa code chạy vòng lập vô tận nhé.
Chú ý là dùng Cursor Type = adOpenDynaset để khi có cập nhật thay đổi danh sách từ máy khác thì nó cũng cập nhật vô Recordset đang chạy luôn. (Tôi không có máy khác để thử)

Chần chừ gì nữa chia sẻ đi bạn.

Mã:
Dim i As Long
    With rs
        .Open ("Select * from [DS$]"), cn, adOpenDynamic, adLockOptimistic
        i = 0
        Do Until i > .RecordCount
            .MoveFirst
            .Move i
            Sheet2.Range("F2").CopyFromRecordset .DataSource, 5, 2
            If i > .RecordCount - 5 Then
                Sheet2.Range("F" & 3 + (.RecordCount - i) & ":G6").ClearContents
            End If
            i = i + 1
            Application.Wait (Now + TimeValue("00:00:01"))
        Loop
    End With
    MsgBox "Het danh sach."
 
    rs.Close
    Set rs = Nothing
 

File đính kèm

Lần chỉnh sửa cuối:
Dùng ADO Recordset với phương thức .DataSource như bác HLMT đã giới thiệu.
Code bên dưới chạy như hình gif trong bài post trước của tôi chứ chưa code chạy vòng lập vô tận nhé.
Chú ý là dùng Cursor Type = adOpenDynaset để khi có cập nhật thay đổi danh sách từ máy khác thì nó cũng cập nhật vô Recordset đang chạy luôn. (Tôi không có máy khác để thử)



Mã:
Dim i As Long
    With rs
        .Open ("Select * from [DS$]"), cn, adOpenDynamic, adLockOptimistic
        i = 0
        Do Until i > .RecordCount
            .MoveFirst
            .Move i
            Sheet2.Range("F2").CopyFromRecordset .DataSource, 5, 2
            If i > .RecordCount - 5 Then
                Sheet2.Range("F" & 3 + (.RecordCount - i) & ":G6").ClearContents
            End If
            i = i + 1
            Application.Wait (Now + TimeValue("00:00:01"))
        Loop
    End With
    MsgBox "Het danh sach."

    rs.Close
    Set rs = Nothing
Cảm ơn @ongke0711 rất nhiều. Từ code của bạn mình sẽ thử áp dụng để show dữ liệu từ SQL Server. Tuy nhiên có 1 vấn đề nhỏ là khi chạy code của bạn, con trỏ chuột nó quay tít, hiện tượng này có cách nào xử lý được không nhỉ ?
 
Dùng ADO Recordset với phương thức .DataSource như bác HLMT đã giới thiệu.
Code bên dưới chạy như hình gif trong bài post trước của tôi chứ chưa code chạy vòng lập vô tận nhé.
Chú ý là dùng Cursor Type = adOpenDynaset để khi có cập nhật thay đổi danh sách từ máy khác thì nó cũng cập nhật vô Recordset đang chạy luôn. (Tôi không có máy khác để thử)



Mã:
Dim i As Long
    With rs
        .Open ("Select * from [DS$]"), cn, adOpenDynamic, adLockOptimistic
        i = 0
        Do Until i > .RecordCount
            .MoveFirst
            .Move i
            Sheet2.Range("F2").CopyFromRecordset .DataSource, 5, 2
            If i > .RecordCount - 5 Then
                Sheet2.Range("F" & 3 + (.RecordCount - i) & ":G6").ClearContents
            End If
            i = i + 1
            Application.Wait (Now + TimeValue("00:00:01"))
        Loop
    End With
    MsgBox "Het danh sach."

    rs.Close
    Set rs = Nothing
Vòng lặp vô tận đây.
Mã:
Sub ScrollRecords()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim so As Integer
    Application.Cursor = xlIBeam
    With cn
        .CursorLocation = adUseClient
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
                            "Extended Properties=""Excel 12.0;HDR=Yes;"";"
        .Open
    End With
    Dim i As Long
    With rs
        .Open ("Select * from [DS$]"), cn, adOpenDynamic, adLockOptimistic
        i = 0
        so = .RecordCount
        For i = 0 To so + 1
            .MoveFirst
            .Move i - 1
            Sheet2.Range("F2:G10").ClearContents
            Sheet2.Range("F2").CopyFromRecordset .DataSource, 5, 2
            i = i + 1
            Application.Wait (Now + TimeValue("00:00:01"))
            If i > so Then
                i = 0
                .MoveFirst
            End If
        Next
    End With
    'MsgBox "Het danh sach."
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub
@MinhKhai
Nhớ reset lại con trỏ chuột về bình thường khi nhấn Ctrl+Pause Break nhé :D
 
Vòng lặp vô tận đây.
Mã:
Sub ScrollRecords()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim so As Integer
    Application.Cursor = xlIBeam
    With cn
        .CursorLocation = adUseClient
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
                            "Extended Properties=""Excel 12.0;HDR=Yes;"";"
        .Open
    End With
    Dim i As Long
    With rs
        .Open ("Select * from [DS$]"), cn, adOpenDynamic, adLockOptimistic
        i = 0
        so = .RecordCount
        For i = 0 To so + 1
            .MoveFirst
            .Move i - 1
            Sheet2.Range("F2:G10").ClearContents
            Sheet2.Range("F2").CopyFromRecordset .DataSource, 5, 2
            i = i + 1
            Application.Wait (Now + TimeValue("00:00:01"))
            If i > so Then
                i = 0
                .MoveFirst
            End If
        Next
    End With
    'MsgBox "Het danh sach."
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub
@MinhKhai
Nhớ reset lại con trỏ chuột về bình thường khi nhấn Ctrl+Pause Break nhé :D
Có thể rút gọn code trên như sau:

Mã:
Sub ScrollRecords()
    Dim so As Integer, i As Integer
    Application.Cursor = xlIBeam
 
    With CreateObject("ADODB.Recordset")
        .Open ("Select * from [DS$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1, 3
        i = 0
        so = .RecordCount
        For i = 0 To so + 1
            .MoveFirst
            .Move i - 1
            Sheet2.Range("F2:G10").ClearContents
            Sheet2.Range("F2").CopyFromRecordset .DataSource, 5, 2
            i = i + 1
            Application.Wait (Now + TimeValue("00:00:01"))
            If i > so Then
                i = 0
                .MoveFirst
            End If
        Next
    End With
  
End Sub

@ongke0711 : Mình thay adOpenDynamic (2) thành adOpenKeyset (1) ở code trên mới có thể chạy được với cách này.
 
Có thể rút gọn code trên như sau:

Mã:
...
            Sheet2.Range("F2:G10").ClearContents
            Sheet2.Range("F2").CopyFromRecordset .DataSource, 5, 2
            ...

@ongke0711 : Mình thay adOpenDynamic (2) thành adOpenKeyset (1) ở code trên mới có thể chạy được với cách này.

Sao trên máy tôi nếu áp dụng kiểu xoá toàn bộ Cell trước khi cập nhật (dùng code của bạn) thì nó nháy hiển thị nội dung rất nhanh, không kịp nhìn, sau đó xoá trắng cell và cứ lặp lại vậy. Không biết có cần thiết lập gì cho Excel không nữa.
 
Có thể rút gọn code trên như sau:

Mã:
Sub ScrollRecords()
    Dim so As Integer, i As Integer
    Application.Cursor = xlIBeam

    With CreateObject("ADODB.Recordset")
        .Open ("Select * from [DS$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1, 3
        i = 0
        so = .RecordCount
        For i = 0 To so + 1
            .MoveFirst
            .Move i - 1
            Sheet2.Range("F2:G10").ClearContents
            Sheet2.Range("F2").CopyFromRecordset .DataSource, 5, 2
            i = i + 1
            Application.Wait (Now + TimeValue("00:00:01"))
            If i > so Then
                i = 0
                .MoveFirst
            End If
        Next
    End With
 
End Sub

@ongke0711 : Mình thay adOpenDynamic (2) thành adOpenKeyset (1) ở code trên mới có thể chạy được với cách này.
Mới thử xong nó chạy kẹt cứng chuột luôn không thoát được
 
Sao trên máy tôi nếu áp dụng kiểu xoá toàn bộ Cell trước khi cập nhật (dùng code của bạn) thì nó nháy hiển thị nội dung rất nhanh, không kịp nhìn, sau đó xoá trắng cell và cứ lặp lại vậy. Không biết có cần thiết lập gì cho Excel không nữa.
Bạn chỉnh lại độ trể thời gian xem thế nào nhé.
Mới thử xong nó chạy kẹt cứng chuột luôn không thoát được
Đúng rồi, vòng lặp vô tận mà anh.
 
Lọc dữ liệu bằng các toán tử sau:

=
<>
>
<
Like x*
Like *x
Like *x*

Rich (BB code):
Sub Filter_HLMT_1()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .Filter = "Code like '*1*'"
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = !Price
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = lngTotal
        Next
    End With
End Sub
 
Lọc dữ liệu bằng các toán tử sau:

=
<>
>
<
Like x*
Like *x
Like *x*

Rich (BB code):
Sub Filter_HLMT_1()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .Filter = "Code like '*1*'"
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = !Price
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = lngTotal
        Next
    End With
End Sub
khai báo 1 Array Public xong chỉ mở kết nối lần đầu tiên chạy code xong cho toán tử like lên Texbox gõ vào lọc thì tốc độ bay vèo vèo đấy
Ứng dụng lọc khá hay
 
Khai thác và đưa lên thử đi anh.
thì code đó viết lại chút à ... để đó 1 tuần sau cho các thành viên khác tham gia xem sao ... ko có ai ý kiếm chi Mạnh viết lại code đó úp cho
cái chủ yếu ở đây là làm cho nhiều người tham gia ấy nó mới vui và khai thác được nhiều góc khuất khác nhau của ADODB mà ta chưa nhìn ra ... đó mới là cái mà mạnh luôn hướng tới trong cách khai thác và viết code ...vv
 
Lọc dữ liệu bằng các toán tử sau:

=
<>
>
<
Like x*
Like *x
Like *x*

Rich (BB code):
Sub Filter_HLMT_1()
...
        .Filter = "Code like '*1*'"
 ...

Tôi thấy một cái hạn chế của Filter và Find là chỉ lọc được một điều kiện mỗi lần (không dùng AND và OR được).
Chẳng lẻ dùng Filter của Filter.
 
Tôi thấy một cái hạn chế của Filter và Find là chỉ lọc được một điều kiện mỗi lần (không dùng AND và OR được).
Chẳng lẻ dùng Filter của Filter.
Được chứ bạn, ví dụ như sau tôi lọc 2 cột với 2 điều kiện:

Rich (BB code):
Sub Filter_HLMT_1()
    Dim intPage As Integer, i As Integer, intSq As Integer, intRecord As Integer
    Dim lngTotal As Long
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .Filter = "Code like '*1*' and Price <950000"
        .PageSize = 20
        Sheet2.Cells.ClearContents
        For intPage = 1 To .PageCount
            lngTotal = 0
            For intRecord = 1 To .PageSize
                i = i + 1
                intSq = intSq + 1
                Sheet2.Range("A" & i) = intSq
                Sheet2.Range("B" & i) = !ID
                Sheet2.Range("C" & i) = !Code
                Sheet2.Range("D" & i) = !Price
                lngTotal = lngTotal + !Price
                .MoveNext
                If .EOF Then Exit For
            Next
            i = i + 1
            Sheet2.Range("C" & i) = "Total:"
            Sheet2.Range("D" & i) = lngTotal
        Next
    End With
End Sub
 
Được chứ bạn, ví dụ như sau tôi lọc 2 cột với 2 điều kiện:

Rich (BB code):
        .Filter = "Code like '*1*' and Price <950000"

Vậy à. Tôi cũng ít dùng cái này nên cũng chưa biết. :)
Tôi thường hay dùng thẳng trong câu lệnh SQL để giảm bớt dung lượng Recordset trả về, nhưng nếu thường xuyên lọc dữ liệu trong một phiên làm việc thì dùng Filter sẽ nhanh hơn vì dữ liệu đã load về sẳn.
 
Tôi vận dụng và khai thác cái hàm lọc vào cái form lọc dữ liệu, các bạn có thể tham khảo và tùy biến sử dụng nhé.

Mã:
Dim rst As Object

Private Sub TextBox1_Change()
    Dim arr As Variant
    If TextBox1.Text = "" Then
        rst.Filter = 0
    Else
        rst.Filter = "Code like '*" & TextBox1.Text & "*'"
    End If
    If rst.EOF Then
        ListBox1.Clear
    Else
        arr = rst.getrows()
        ListBox1.ColumnCount = rst.Fields.Count
        ListBox1.Column = arr
    End If
End Sub

Private Sub UserForm_Initialize()
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
    TextBox1.Text = "001"
End Sub

1605505552143.png
 

File đính kèm

Tôi vận dụng và khai thác cái hàm lọc vào cái form lọc dữ liệu, các bạn có thể tham khảo và tùy biến sử dụng nhé.

Mã:
Dim rst As Object

Private Sub TextBox1_Change()
    Dim arr As Variant
    If TextBox1.Text = "" Then
        rst.Filter = 0
    Else
        rst.Filter = "Code like '*" & TextBox1.Text & "*'"
    End If
    If rst.EOF Then
        ListBox1.Clear
    Else
        arr = rst.getrows()
        ListBox1.ColumnCount = rst.Fields.Count
        ListBox1.Column = arr
    End If
End Sub

Private Sub UserForm_Initialize()
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
    TextBox1.Text = "001"
End Sub

View attachment 249426
Mạnh biết mà .... HLMT biết lâu ròi có điều chưa có viết đó thôi
 
Hay nhỉ, học được 1 chiêu Filter . Anh number one:thumbs:
Múa rìu qua mắt thợ thôi em.
Mạnh biết mà .... HLMT biết lâu ròi có điều chưa có viết đó thôi
Tại thợ chưa có múa nên mình múa đại xem sao. Nếu trật thì nhận góp ý để cải thiện, còn hên trúng thì mọi người có thể tùy biến mà dùng.
---
Làm luôn cái nút xuất kết quả sau khi lọc ra địa chỉ K2 luôn. Lưu ý tôi chỉ chia sẻ những cái cơ bản để làm sao mọi người có thể đọc và hiểu còn khi sử dụng thì phải tùy biến nhé.

Mã:
Private Sub CommandButton1_Click()
    Dim arr As Variant
    arr = ListBox1.List
    Sheet1.Range("K2:M100").ClearContents
    Sheet1.Range("K2:M" & rst.RecordCount + 1) = arr
End Sub

1605508637342.png
 

File đính kèm

Múa rìu qua mắt thợ thôi em.

Tại thợ chưa có múa nên mình múa đại xem sao. Nếu trật thì nhận góp ý để cải thiện, còn hên trúng thì mọi người có thể tùy biến mà dùng.
---
Làm luôn cái nút xuất kết quả sau khi lọc ra địa chỉ K2 luôn. Lưu ý tôi chỉ chia sẻ những cái cơ bản để làm sao mọi người có thể đọc và hiểu còn khi sử dụng thì phải tùy biến nhé.

Mã:
Private Sub CommandButton1_Click()
    Dim arr As Variant
    arr = ListBox1.List
    Sheet1.Range("K2:M100").ClearContents
    Sheet1.Range("K2:M" & rst.RecordCount + 1) = arr
End Sub

View attachment 249432
Cảm ơn anh Hai Lúa, ứng dụng này OT thấy gặp nhiều trong thực tế ạ.
Anh Hai Lùa cho OT hỏi thêm bài này sau khi lọc theo điều kiện trong 'TextBox1' rồi sau đó kết quả sẽ hiển thị ở 'ListBox1' ví dụ có 10 dòng kết quả ta có thể lựa chọn (kích chuột hoặc tích) những dòng muốn sau đó mới bấm ghi xuống sheet, thay vì là ghi toàn bộ được không ạ.
 
Từ thành công bài #144 Mạnh nêu tiếp cho Bạn nào iU thích ADODB làm tiếp nè

Trong code sau ta viết lại thành 1 hàm có 2 tham số: Hàm( SQL, Filepath )

Mã:
Private Sub UserForm_Initialize()
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
    TextBox1.Text = "001"
End Sub
Tại sao viết thành 1 hàm

1/ Filepath = Tùy chọn lấy cùng File Or Khác file
2/ SQL = Tùy chọn lấy dữ liệu
3/ Cái quan trọng nhất viết 1 lần xong xài hoài cứ thế keo nó thôi rút ngắn lại rất nhiều code trên 1 files và gọn lại rễ quản lý + bảo trì code
...
còn nữa tạm vậy cứ làm đi xong tính tiếp ... vừa chơi vừa nguyên cứu nó mới vui
 
Cảm ơn anh Hai Lúa, ứng dụng này OT thấy gặp nhiều trong thực tế ạ.
Anh Hai Lùa cho OT hỏi thêm bài này sau khi lọc theo điều kiện trong 'TextBox1' rồi sau đó kết quả sẽ hiển thị ở 'ListBox1' ví dụ có 10 dòng kết quả ta có thể lựa chọn (kích chuột hoặc tích) những dòng muốn sau đó mới bấm ghi xuống sheet, thay vì là ghi toàn bộ được không ạ.
Em thử code sau nhé.

Mã:
Private Sub CommandButton1_Click()
    'Dim arr As Variant
    'arr = ListBox1.List
    'Sheet1.Range("K2:M100").ClearContents
    'Sheet1.Range("K2:M" & rst.RecordCount + 1) = arr
    Sheet1.Range("K2:M1000").ClearContents
    Dim rng  As Range, i As Integer, col As Integer
    Set rng = Worksheets("Sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1)
     For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            For col = 0 To ListBox1.ColumnCount - 1
                rng.Offset(, col).Value = ListBox1.List(i, col)
            Next
            Set rng = rng.Offset(1)
            ListBox1.Selected(i) = False
        End If
    Next
 
End Sub
 

File đính kèm

Em thử code sau nhé.

Mã:
Private Sub CommandButton1_Click()
    'Dim arr As Variant
    'arr = ListBox1.List
    'Sheet1.Range("K2:M100").ClearContents
    'Sheet1.Range("K2:M" & rst.RecordCount + 1) = arr
    Sheet1.Range("K2:M1000").ClearContents
    Dim rng  As Range, i As Integer, col As Integer
    Set rng = Worksheets("Sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1)
     For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            For col = 0 To ListBox1.ColumnCount - 1
                rng.Offset(, col).Value = ListBox1.List(i, col)
            Next
            Set rng = rng.Offset(1)
            ListBox1.Selected(i) = False
        End If
    Next

End Sub
Ôi được rồi anh ạ,OT cảm ơn anh Hai Lúa nhiều ạ, không biết trong form có thể thiết kế được tiêu đề cột không anh nhỉ,
Còn ở sheet thì không cần cũng được vì có thể thiết lập sẵn ở dưới sheet chẳng hạn.
 
Ôi được rồi anh ạ,OT cảm ơn anh Hai Lúa nhiều ạ, không biết trong form có thể thiết kế được tiêu đề cột không anh nhỉ,
Còn ở sheet thì không cần cũng được vì có thể thiết lập sẵn ở dưới sheet chẳng hạn.
Anh nhớ có lần anh @batman1 đã chia sẻ về cách làm cái tiêu đề cột cho listbox em tìm thử xem sao nhé.
 
Anh nhớ có lần anh @batman1 đã chia sẻ về cách làm cái tiêu đề cột cho listbox em tìm thử xem sao nhé.
Dạ vâng anh, OT cũng đã thử để thuộc tính ColumnHeads = True nhưng cũng không được vì có thể sau khi dữ liệu lọc bằng ADO để đưa vào khác với dữ liệu lấy trực tiếp từ sheet nên không được ạ, chắc vấn đề phải xử lý trong cả câu lệnh lọc nữa mới xong anh ạ hihi.
Cảm ơn anh Hai Lúa.
 
Em thử code sau nhé.

Mã:
Private Sub CommandButton1_Click()
    'Dim arr As Variant
    'arr = ListBox1.List
    'Sheet1.Range("K2:M100").ClearContents
    'Sheet1.Range("K2:M" & rst.RecordCount + 1) = arr
    Sheet1.Range("K2:M1000").ClearContents
    Dim rng  As Range, i As Integer, col As Integer
    Set rng = Worksheets("Sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1)
     For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            For col = 0 To ListBox1.ColumnCount - 1
                rng.Offset(, col).Value = ListBox1.List(i, col)
            Next
            Set rng = rng.Offset(1)
            ListBox1.Selected(i) = False
        End If
    Next

End Sub
Thi thoảng OT thấy dữ liệu ghi xuống cả cột U:W hay sao ấy anh Hai Lúa ơi.
1605515840285.png
 
Lần chỉnh sửa cuối:
Thi thoảng OT thấy dữ liệu ghi xuống cả cột U:W hay sao ấy anh Hai Lúa ơi.
View attachment 249446
Không biết là em đã tìm được hướng khắc phục cho vấn đề này hay là chưa? Thôi anh nói luôn, khi em ghi dữ liệu từ Listbox xuống Sheet, mà sheet dữ liệu nguồn cũng chính là sheet để ta ghi dữ liệu. Khi ta đóng form, mở form lên lại thì nó sẽ nạp hết dữ liệu của sheet bao gồm cả dữ liệu em vừa ghi xuống vào Listbox. Mấu chốt là nó nằm ở câu lệnh truy vấn Select * From [Sheet1$], hoặc chỗ:
Mã:
 ListBox1.ColumnCount = rst.Fields.Count
Thay thành
Mã:
 ListBox1.ColumnCount = 3 ' rst.Fields.Count
Em có thể điều chỉnh 1 trong 2 điểm trên hoặc ghi dữ liệu xuống sheet khác sheet1 là được.
Hãy thử nhé.
 
Không biết là em đã tìm được hướng khắc phục cho vấn đề này hay là chưa? Thôi anh nói luôn, khi em ghi dữ liệu từ Listbox xuống Sheet, mà sheet dữ liệu nguồn cũng chính là sheet để ta ghi dữ liệu. Khi ta đóng form, mở form lên lại thì nó sẽ nạp hết dữ liệu của sheet bao gồm cả dữ liệu em vừa ghi xuống vào Listbox. Mấu chốt là nó nằm ở câu lệnh truy vấn Select * From [Sheet1$], hoặc chỗ:
Mã:
 ListBox1.ColumnCount = rst.Fields.Count
Thay thành
Mã:
 ListBox1.ColumnCount = 3 ' rst.Fields.Count
Em có thể điều chỉnh 1 trong 2 điểm trên hoặc ghi dữ liệu xuống sheet khác sheet1 là được.
Hãy thử nhé.
Cảm ơn anh Hai Lúa nhiều ạ, sau khi được anh chỉ dẫn OT đã hiểu được vấn đề, câu lệnh: Select * From [Sheet1$] nó sẽ lấy toàn bộ dữ liệu trong sheet 1 nên nó lấy cả dữ liệu cũ và dữ liệu kết quả.
OT đã hiểu và có thể tự mình xử lý được vấn đề này ạ.
Cảm ơn Hai Lúa rất nhiều.
 
Lấy dữ liệu xong rồi thì ta đến thêm dữ liệu nhé. Cũng file mẫu bài số 1, Code nhập liệu như sau:

Mã:
Sub AddNew_HLMT_1()
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1, 3
        .AddNew
            !ID = "ID1000"
            !Code = "VT1000"
            !Price = 2020
        .Update
    End With
End Sub
 
Lấy dữ liệu xong rồi thì ta đến thêm dữ liệu nhé. Cũng file mẫu bài số 1, Code nhập liệu như sau:

Mã:
Sub AddNew_HLMT_1()
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1, 3
        .AddNew
            !ID = "ID1000"
            !Code = "VT1000"
            !Price = 2020
        .Update
    End With
End Sub
Thêm sửa và xóa nữa đi anh Hai Lúa ơi :-=
 
Sub GetRs(dongtradulieu as string,ByVal dongdau As Long, ByVal dongcuoi As Long)
With CreateObject("ADODB.Recordset")
.Open ("Select * from [Sheet1$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
.Move dongdau
Sheet2.Range(dongtradulieu).CopyFromRecordset .DataSource, dongcuoi
End With
End Sub
Sub Main()
Call GetRs("A2",29, 70)
End Sub
Thế này được không nhanh mạnh
 
có lẻ nên mở rộng chủ đề nghiên cứu thêm Rs.UpdateBatch ở nhiều cách tiếp cận ADODB khác nhau đi ... vì trên GPE này thấy còn quá ít cho nó
 
Trong CSDL Excel thì nó có giới hạn không cho xóa nhé em.
Một CSDL có data (dữ liệu) và metadata (hạ tầng có sở, tức dữ liệu về dữ liệu và cấu trúc của chúng).
CSV thì có metatdata đơn giản (điển hình: chỉ dấu phẩy chia cách các cột)
Nhưng Excel thì metatdata phức tạp hơn nhiều. Điển hình, nó có cả một cái vec tơ map để map các ô trong bảng tính.
ADO là công cụ COM để trích xuất dữ liệu. Để đọc dữ liệu trong file Excel, ADO phải đi tắt (shortcut) một số metadata. MS mắt buộc phải giới hạn tính chất sửa xoá để tránh trường hợp dữ liệu mới bị "lạc bầy" (mất liên hệ với metadata)

Quý vị nào muốn làm việc với CSDL thì nên tìm hiểu cho rõ về metadata.
 
Sub GetRs(dongtradulieu as string,ByVal dongdau As Long, ByVal dongcuoi As Long)
...
.Open ("Select * from [Sheet1$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
...
Sheet2.Range(dongtradulieu).CopyFromRecordset .DataSource, dongcuoi

Thế này được không nhanh mạnh

Vẫn còn các tham số Sheet1, Sheet2 cố định trong hàm :) , không thể tuỳ biến.
Đối với tôi khi viết hàm/ thủ tục thì không phải chỉ chuyển các tham số thành các biến để truyền trong hàm mà còn phải xét tổng thể nghiệp vụ, qui trình xử lý, các bẫy lỗi, các trường hợp có thể phát sinh v.v.. để viết cái hàm phù hợp để có thể tái sử dụng. Một thủ tục trên có thể tách thành mấy hàm để xử lý linh hoạt.
Ví dụ:
- Nếu tôi muốn kết nối tới Excel 2003 (.xls) thì chuỗi kết nối trên có phù hợp không?
- Nếu tôi không muốn "Select *..." mà "Select F1, F4, F7..." thì như thế nào?
- ...
Trên đây chỉ là một số gợi ý tham khảo thêm để viết các hàm, thủ tục cho ứng dụng. Còn các ví dụ của bác HLMT trong chủ đề này thì cứ dùng cách viết đơn giản nhất để mọi người dễ hiểu, dễ tham khảo từng bước thôi.
 
Lần chỉnh sửa cuối:
Vẫn còn các tham số Sheet1, Sheet2 cố định trong hàm :) , không thể tuỳ biến.
Đối với tôi khi viết hàm/ thủ tục thì không phải chỉ chuyển các tham số thành các biến để truyền trong hàm mà còn phải xét tổng thể nghiệp vụ, qui trình xử lý, các bẫy lỗi, các trường hợp có thể phát sinh v.v.. để viết cái hàm phù hợp để có thể tái sử dụng. Một thủ tục trên có thể tách thành mấy hàm để xử lý linh hoạt.
Ví dụ:
- Nếu tôi muốn kết nối tới Excel 2003 (.xls) thì chuỗi kết nối trên có phù hợp không?
- Nếu tôi không muốn "Select *..." mà "Select F1, F4, F7..." thì như thế nào?
- ...
Trên đây chỉ là một số gợi ý tham khảo thêm để viết các hàm, thủ tục cho ứng dụng. Còn các ví dụ của bác HLMT trong chủ đề này thì cứ dùng cách viết đơn giản nhất để mọi người dễ hiểu, dễ tham khảo từng bước thôi.
Khoảng 10 năm trước thì việc viết hàm/thủ tục có tính cách tổng thể khá quan trọng.
Nhưng hiện giờ thì thế giới phần mềm đã thay đổi nhiều, và với tôcvs độ rất nhanh. Những gì hôm nay là tối ưu vẫn có thể trở thành lỗi thời ngày mai.
Vì vậy khuynh hướng mới bây giờ là chỉ tổng thể những gì rất vững chắc, ít thay đổi.

Sau một thời gian tiếp xúc với GPE, tôi có hai nhận xét (mỗi nhận xét đi kèm với lời khuyên):

1. Hầu hết những nhu cầu ở GPE thuộc về loại cấp thời, thay đổi liên tục. Vì vậy chỉ thích hợp với loại code cần tới đâu viết tới đó. Thư viện thì chỉ thích hợp với loại code "mì ăn liền", tức là bạn tự lập cho mình một cái file (hoặc một folder với một đống files) text hay word với những đoạn code thường dùng, khi cần viết code thì cứ việc giở ra mà copy/paste.

2. Cách viết hàm/thủ tục tổng thể ở đây (GPE) là viết một cái hàm/thủ tục tổ bố với một đống options. Đọc muốn xỉu.
Trên thực tế, kỹ thuật viết hàm thư viện không phải vậy. Người ta tách từng công việc riêng biệt ra thành hàm riêng. Cái hàm tổng thể sẽ gọi các hàm nhỏ kia mà làm đúng công việc cần thiết. Nói cách khác, cái hàm/thủ tục tổng thể với nhiều options không phải là một hàm từ a đến z, mà là một nhóm hàm với một vài cái giao diện của hàm chính (*).

(*) đối với lập trình hướng đối tượng thì điều này là bắt buộc. Và đó là một trong những lợi điểm của LTHĐT.
 
Chỉnh sửa dữ liệu, ví dụ với file mẫu bài 1, tôi muốn chỉnh sửa dữ liệu trong cột Code = 'HAI LÚA' và cột Price =100 với điều kiện cột ID có giá trị là 'TP0005' thì code như sau:
Rich (BB code):
Sub ChinhSuaDL_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, , 3
        .Filter = "[ID]='TP0005'"
        !Price = 100
        !Code = "HAI LÚA"
        .Update
    End With
End Sub

1605924791756.png
 
Cũng file mẫu bài số 1, tôi tiến hành xuất kết quả truy vấn với điều kiện cột [ID] khác 'TP0001' và cột [PRICE] <1.000.000 ([ID]<>'TP0001' and [PRICE] <1000000) ra file *.Csv
Code như sau:

Rich (BB code):
Sub LuuFileCsv_HLMT()
    Dim strRecord As String
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1, 3
        .Filter = "[ID]<>'TP0001' and [PRICE] <1000000"
        strRecord = .GetString(, , ";", vbCrLf)
        .Close
    End With
    CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\Test.csv").Write strRecord
End Sub

Kết quả:

1606180780558.png
 
Cũng file mẫu bài số 1, tôi tiến hành xuất kết quả truy vấn với điều kiện cột [ID] khác 'TP0001' và cột [PRICE] <1.000.000 ([ID]<>'TP0001' and [PRICE] <1000000) ra file *.xml
Code như sau:

Mã:
Sub LuuFileXML_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName 
        .Filter = "[ID]<>'TP0001' and [PRICE] <1000000"
        .Save ThisWorkbook.Path & "\Test.xml", 1
    End With
End Sub

Kết quả:
XML:
<xml xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882'
    xmlns:dt='uuid:C2F41010-65B3-11d1-A29F-00AA00C14882'
    xmlns:rs='urn:schemas-microsoft-com:rowset'
    xmlns:z='#RowsetSchema'>
<s:Schema id='RowsetSchema'>
    <s:ElementType name='row' content='eltOnly'>
        <s:AttributeType name='ID' rs:number='1' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='string' dt:maxLength='255'/>
        </s:AttributeType>
        <s:AttributeType name='Code' rs:number='2' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='string' dt:maxLength='255'/>
        </s:AttributeType>
        <s:AttributeType name='Price' rs:number='3' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='float' dt:maxLength='8' rs:precision='15' rs:fixedlength='true'/>
        </s:AttributeType>
        <s:extends type='rs:rowbase'/>
    </s:ElementType>
</s:Schema>
<rs:data>
    <z:row ID='TP0002' Code='MBY001' Price='250000'/>
    <z:row ID='TP0003' Code='MBY002' Price='300000'/>
    <z:row ID='TP0004' Code='MBY002' Price='350000'/>
    <z:row ID='TP0005' Code='MBY002' Price='400000'/>
    <z:row ID='TP0006' Code='MBY003' Price='450000'/>
    <z:row ID='TP0007' Code='MBY004' Price='500000'/>
    <z:row ID='TP0008' Code='MBY005' Price='550000'/>
    <z:row ID='TP0009' Code='MBY006' Price='600000'/>
    <z:row ID='TP0010' Code='MBY007' Price='650000'/>
    <z:row ID='TP0011' Code='MBY008' Price='700000'/>
    <z:row ID='TP0012' Code='MBY009' Price='750000'/>
    <z:row ID='TP0013' Code='MBY010' Price='800000'/>
    <z:row ID='TP0014' Code='MBY011' Price='850000'/>
    <z:row ID='TP0015' Code='MBY012' Price='900000'/>
    <z:row ID='TP0016' Code='MBY013' Price='950000'/>
</rs:data>
</xml>
 
Cũng file mẫu bài số 1, tôi tiến hành xuất kết quả truy vấn với điều kiện cột [ID] khác 'TP0001' và cột [PRICE] <1.000.000 ([ID]<>'TP0001' and [PRICE] <1000000) ra file *.xml
Code như sau:

Mã:
Sub LuuFileXML_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
        .Filter = "[ID]<>'TP0001' and [PRICE] <1000000"
        .Save ThisWorkbook.Path & "\Test.xml", 1
    End With
End Sub

Kết quả:
XML:
<xml xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882'
    xmlns:dt='uuid:C2F41010-65B3-11d1-A29F-00AA00C14882'
    xmlns:rs='urn:schemas-microsoft-com:rowset'
    xmlns:z='#RowsetSchema'>
<s:Schema id='RowsetSchema'>
    <s:ElementType name='row' content='eltOnly'>
        <s:AttributeType name='ID' rs:number='1' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='string' dt:maxLength='255'/>
        </s:AttributeType>
        <s:AttributeType name='Code' rs:number='2' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='string' dt:maxLength='255'/>
        </s:AttributeType>
        <s:AttributeType name='Price' rs:number='3' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='float' dt:maxLength='8' rs:precision='15' rs:fixedlength='true'/>
        </s:AttributeType>
        <s:extends type='rs:rowbase'/>
    </s:ElementType>
</s:Schema>
<rs:data>
    <z:row ID='TP0002' Code='MBY001' Price='250000'/>
    <z:row ID='TP0003' Code='MBY002' Price='300000'/>
    <z:row ID='TP0004' Code='MBY002' Price='350000'/>
    <z:row ID='TP0005' Code='MBY002' Price='400000'/>
    <z:row ID='TP0006' Code='MBY003' Price='450000'/>
    <z:row ID='TP0007' Code='MBY004' Price='500000'/>
    <z:row ID='TP0008' Code='MBY005' Price='550000'/>
    <z:row ID='TP0009' Code='MBY006' Price='600000'/>
    <z:row ID='TP0010' Code='MBY007' Price='650000'/>
    <z:row ID='TP0011' Code='MBY008' Price='700000'/>
    <z:row ID='TP0012' Code='MBY009' Price='750000'/>
    <z:row ID='TP0013' Code='MBY010' Price='800000'/>
    <z:row ID='TP0014' Code='MBY011' Price='850000'/>
    <z:row ID='TP0015' Code='MBY012' Price='900000'/>
    <z:row ID='TP0016' Code='MBY013' Price='950000'/>
</rs:data>
</xml>
Có vẻ độc thoại có một mình buồn nhỉ ... Mạnh mà vào là lại nổi sóng ngay và luôn he ... có điều kỳ này làm biếng lắm

1/ Viết xuất xml rồi => xong
2/ Viết tiếp các kiểu ActiveWorkbook.XmlImport nữa đi chứ cho nó chọn bộ ?!
 
Có vẻ độc thoại có một mình buồn nhỉ ... Mạnh mà vào là lại nổi sóng ngay và luôn he ... có điều kỳ này làm biếng lắm

1/ Viết xuất xml rồi => xong
2/ Viết tiếp các kiểu ActiveWorkbook.XmlImport nữa đi chứ cho nó chọn bộ ?!
Đang khai thác Recordset mà anh. Vậy nên mình phải lấy từ Recordset.
 
Có vẻ độc thoại có một mình buồn nhỉ ... Mạnh mà vào là lại nổi sóng ngay và luôn he ... có điều kỳ này làm biếng lắm
Hôm bữa có thấy bạn có đưa mấy đề tài liên quan mà chưa thấy demo, trả lời để mọi người học hỏi thì nó xôm tụ chứ.
 
Cũng file mẫu bài số 1, tôi tiến hành xuất kết quả truy vấn với điều kiện cột [ID] khác 'TP0001' và cột [PRICE] <1.000.000 ([ID]<>'TP0001' and [PRICE] <1000000) ra file *.xml
Code như sau:

Mã:
Sub LuuFileXML_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
        .Filter = "[ID]<>'TP0001' and [PRICE] <1000000"
        .Save ThisWorkbook.Path & "\Test.xml", 1
    End With
End Sub

Kết quả:
XML:
<xml xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882'
    xmlns:dt='uuid:C2F41010-65B3-11d1-A29F-00AA00C14882'
    xmlns:rs='urn:schemas-microsoft-com:rowset'
    xmlns:z='#RowsetSchema'>
<s:Schema id='RowsetSchema'>
    <s:ElementType name='row' content='eltOnly'>
        <s:AttributeType name='ID' rs:number='1' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='string' dt:maxLength='255'/>
        </s:AttributeType>
        <s:AttributeType name='Code' rs:number='2' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='string' dt:maxLength='255'/>
        </s:AttributeType>
        <s:AttributeType name='Price' rs:number='3' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>
            <s:datatype dt:type='float' dt:maxLength='8' rs:precision='15' rs:fixedlength='true'/>
        </s:AttributeType>
        <s:extends type='rs:rowbase'/>
    </s:ElementType>
</s:Schema>
<rs:data>
    <z:row ID='TP0002' Code='MBY001' Price='250000'/>
    <z:row ID='TP0003' Code='MBY002' Price='300000'/>
    <z:row ID='TP0004' Code='MBY002' Price='350000'/>
    <z:row ID='TP0005' Code='MBY002' Price='400000'/>
    <z:row ID='TP0006' Code='MBY003' Price='450000'/>
    <z:row ID='TP0007' Code='MBY004' Price='500000'/>
    <z:row ID='TP0008' Code='MBY005' Price='550000'/>
    <z:row ID='TP0009' Code='MBY006' Price='600000'/>
    <z:row ID='TP0010' Code='MBY007' Price='650000'/>
    <z:row ID='TP0011' Code='MBY008' Price='700000'/>
    <z:row ID='TP0012' Code='MBY009' Price='750000'/>
    <z:row ID='TP0013' Code='MBY010' Price='800000'/>
    <z:row ID='TP0014' Code='MBY011' Price='850000'/>
    <z:row ID='TP0015' Code='MBY012' Price='900000'/>
    <z:row ID='TP0016' Code='MBY013' Price='950000'/>
</rs:data>
</xml>
Sau khi chạy code trên ta được file có tên là Test.xml. Tiến hành lấy dữ liệu từ file được tạo ra đó bằng code sau:

Rich (BB code):
Sub LayDL_XML_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open ThisWorkbook.Path & "\Test.xml", "Provider=MSPersist"
        Sheet2.Range("A2").CopyFromRecordset .DataSource
    End With
End Sub
 
Như trên có bài viết nói về việc đưa mảng vào Listbox để thay cho hàm TRANSPOSE hoặc xoay mảng bằng hàm tự tạo. Nay tôi xin tạm viết cái gợi ý đó thành cái hàm như sau:

Mã:
Public Function GetRsValues(strSQL As String, rng As Range, Optional strPath As String) As Variant
    On Error GoTo ErrorHandler
    With CreateObject("ADODB.Recordset")
        .Open (strSQL), ("Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & IIf(Len(strPath) = 0, ThisWorkbook.FullName, strPath))
        GetRsValues = .GetRows
    End With
    With CreateObject("New:{8BD21D20-EC42-11CE-9E0D-00AA006002F3}")
        .Column = GetRsValues
        GetRsValues = .List
    End With
    rng.Resize(UBound(GetRsValues) + 1, UBound(GetRsValues, 2) + 1) = GetRsValues
    Exit Function
ErrorHandler:
    MsgBox Err.Description
End Function

Như dữ liệu bài 1 tôi thử hàm trên như sau:

Mã:
Sub Test_GetRsValues()
    Call GetRsValues("Select * from [Sheet1$]", Sheet2.Range("A2"))
End Sub

Dữ liệu sẽ được đổ vào cell A2 của sheet2. Hàm trên còn 1 tham số cuối chưa truyền vào đó là đường dẫn đến file (strPath) bởi vì nó được lấy dữ liệu ở chính file đó. Nếu các bạn muốn lấy file khác với file chạy code thì phải thêm 1 tham số còn lại là đường dẫn đến file nguồn nhé.
 
Như trên có bài viết nói về việc đưa mảng vào Listbox để thay cho hàm TRANSPOSE hoặc xoay mảng bằng hàm tự tạo. Nay tôi xin tạm viết cái gợi ý đó thành cái hàm như sau:

Mã:
Public Function GetRsValues(strSQL As String, rng As Range, Optional strPath As String) As Variant
    On Error GoTo ErrorHandler
    With CreateObject("ADODB.Recordset")
        .Open (strSQL), ("Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & IIf(Len(strPath) = 0, ThisWorkbook.FullName, strPath))
        GetRsValues = .GetRows
    End With
    With CreateObject("New:{8BD21D20-EC42-11CE-9E0D-00AA006002F3}")
        .Column = GetRsValues
        GetRsValues = .List
    End With
    rng.Resize(UBound(GetRsValues) + 1, UBound(GetRsValues, 2) + 1) = GetRsValues
    Exit Function
ErrorHandler:
    MsgBox Err.Description
End Function

Như dữ liệu bài 1 tôi thử hàm trên như sau:

Mã:
Sub Test_GetRsValues()
    Call GetRsValues("Select * from [Sheet1$]", Sheet2.Range("A2"))
End Sub

Dữ liệu sẽ được đổ vào cell A2 của sheet2. Hàm trên còn 1 tham số cuối chưa truyền vào đó là đường dẫn đến file (strPath) bởi vì nó được lấy dữ liệu ở chính file đó. Nếu các bạn muốn lấy file khác với file chạy code thì phải thêm 1 tham số còn lại là đường dẫn đến file nguồn nhé.
Thì hôm lâu rồi ở thớt khác Mạnh có nói rồi nay mới thấy Úp he
Mạnh cảm giác thấy mình như con sâu code trên GPE này ý ... khả năng của ai sao thì gần như có thể đoán ra he
 
Thì hôm lâu rồi ở thớt khác Mạnh có nói rồi nay mới thấy Úp he
Mạnh cảm giác thấy mình như con sâu code trên GPE này ý ... khả năng của ai sao thì gần như có thể đoán ra he
Hàm trên chỉ là căn bản, muốn sử dụng ta cần phải thêm thắt rất nhiều.
 
Đưa một vùng dữ liệu trên bảng tính vào Recordset có nhiều cách. Tuy nhiên hôm nay tôi xin giới thiệu cách đưa vào từ XML
Cũng ví dụ file mẫu bài 1, tôi đưa vùng dữ liệu từ A1 : C109 với điều kiện cột Price <= 900.000 sau đó sắp xếp cột này theo thứ tự giảm dần.
Code sẽ như sau:
Mã:
Sub Rng2Rst()
    Dim objXML As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    objXML.LoadXML Sheet1.Range("A1:C109").Value(12)
    With CreateObject("ADODB.Recordset")
        .Open objXML
        .Filter = "[Price] <= 900000"
        .Sort = "[Price] DESC"
        Sheet2.Range("A2").CopyFromRecordset .DataSource
    End With
End Sub
Kết quả như hình bên dưới:
1606964038036.png
 
Lần chỉnh sửa cuối:
Lần chỉnh sửa cuối:
khi nào rảnh các bạn đổi hướng sang thử xài API của Bill đi xem sao ???!!!

Google 1 hồi ra đầy code mẫu cho mà test
govert/SQLiteForExcel: A lightweight wrapper to give access to the SQLite3 library from VBA. (github.com)

Connect to SQLite from VBA using winsqlite3.dll (renenyffenegger.ch)

Bạn có đọc hiểu cái thư viện này làm gì chưa mà nói của Bill? Của tay Govert viết ra nhé.
SQLite thì có liên quan như thế nào đến chủ đề này bạn? Hay bạn muốn ứng dụng Excel dùng SQLite làm CSDL back end hay muốn đọc ghi dữ liệu từ các thiết bị điện thoại, máy chơi game, remote ...
 
Lần chỉnh sửa cuối:
Bạn có đọc hiểu cái thư viện này làm gì chưa mà nói của Bill? Của tay Govert viết ra nhé.
SQLite thì có liên quan như thế nào đến chủ đề này bạn? Hay bạn muốn ứng dụng Excel dùng SQLite làm CSDL back end hay muốn đọc ghi dữ liệu từ các thiết bị điện thoại, máy chơi game, remote ...
Hình như có nhầm lẫn gì đó anh.

winsqlite3.dll chắc chắn là của Microsoft.

1607141430590.png

Còn cái SQLiteForExcel là cái khác.

1607141497766.png
 
Hình như có nhầm lẫn gì đó anh.

winsqlite3.dll chắc chắn là của Microsoft.

View attachment 250630

Còn cái SQLiteForExcel là cái khác.

View attachment 250631

Thì cũng là link bạn Mạnh đưa lên thôi và cái winsqlite3.dll cũng chỉ dùng để tương tác với SQLite database thôi.
Vậy ứng dụng nó ra sao trong Excel và nếu dùng nó có gì hay hơn so với vụ dùng ADODB để kết nối nguồn dữ liệu Excel mà phải đổi hướng xài nó vậy? Tôi chưa xài tới nó bao giờ vì chưa thấy có nhu cầu trong hiện tại của tôi, nếu bạn Mạnh thấy được tính ứng dụng của nó thì khai sáng cho mọi người nhé hoặc bạn Mạnh tạo cái chủ đề mới giới thiệu về nó và ứng dụng cho mọi người học hỏi.
 
Lần chỉnh sửa cuối:
Thì cũng là link bạn Mạnh đưa lên thôi và cái winsqlite3.dll cũng chỉ dùng để tương tác với SQLite database thôi.
Link em gửi khác mà (anh click vào ảnh thứ nhất ấy).

Chắc anh ấy tìm thấy cái gì đó hay hay thì úp lên thôi.
Cái thư viện đó có thể dùng độc lập, không cần tới Office mà vẫn làm việc được với các file Access, Excel. Đại khái thế.
 
Link em gửi khác mà (anh click vào ảnh thứ nhất ấy).

Chắc anh ấy tìm thấy cái gì đó hay hay thì úp lên thôi.
Cái thư viện đó có thể dùng độc lập, không cần tới Office mà vẫn làm việc được với các file Access, Excel. Đại khái thế.
vãi lắm bài 177 Mạnh chụp cái hình to trà bá đó mà không dòm cứ mở cái link kia

1 cái link là ý tưởng code đó có trước khi bill cho File winsqlite3.dll vào Windows10 ( Lưu ý chỉ mới có trên Window10 nhé )

1607144693186.png
Còn cái link kia là hướng dẫn xài cho VBA đấy
Connect to SQLite from VBA using winsqlite3.dll (renenyffenegger.ch)
1607144769903.png
 
Lần chỉnh sửa cuối:
vãi lắm bài 177 Mạnh chụp cái hình to trà bá đó mà không dòm cứ mở cái link kia

1 cái link là ý tưởng code đó có trước khi bill cho File winsqlite3.dll vào Windows10 ( Lưu ý chỉ mới có trên Window10 nhé )

View attachment 250632
Còn cái link kia là hướng dẫn xài cho VBA đấy
Connect to SQLite from VBA using winsqlite3.dll (renenyffenegger.ch)

Đồngh ý cái winsqlite.dll của của Widnows 10 và túm lại, vậy lợi ích của nó đối với chủ đề này là gì vậy bạn? Một đống câu hỏi post trước của tôi đó, bạn dùng nó khai thác cái gì vậy? Hay đưa lên chơi chơi thôi, không có tính thực dụng ở đây.
 
Đồngh ý cái winsqlite.dll của của Widnows 10 và túm lại, vậy lợi ích của nó đối với chủ đề này là gì vậy bạn? Một đống câu hỏi post trước của tôi đó, bạn dùng nó khai thác cái gì vậy? Hay đưa lên chơi chơi thôi, không có tính thực dụng ở đây.
bài 177 dòng màu đỏ

1607153206880.png


bài 182 dòng màu đỏ tây nó nói
1607153296766.png
đó là câu trả lời cho bạn .... đã nói hết rồi mà .... có vậy mà cũng hỏi ... vãi thật
 
bài 177 dòng màu đỏ

View attachment 250639


bài 182 dòng màu đỏ tây nó nói
View attachment 250640
đó là câu trả lời cho bạn .... đã nói hết rồi mà .... có vậy mà cũng hỏi ... vãi thật

:D Vậy là bạn không hiểu tôi hỏi gì. Mà bạn biết SQLite chứ?. Tôi cũng ngưng ở đây vì thông qua đây đã biết việc trao đổi này chẳng có tính thực tế gì.
 
Lần chỉnh sửa cuối:
Sẵn tiện nghiên cứu SQL lite thì tuỳ vào khả năng của từng bạn mà nghiên cứu luôn
Oracle, MySQL, SQLServer, TurboDB, DBisam, PostgreSQL luôn đi he tài liệu Google.
Còn mình thì Pó tay :eek:

Anh @Hai Lúa Miền Tây xuất chiêu tiếp đi anh, để cho em và mọi người chưa biết học hỏi
 
Tìm kiếm dữ liệu với dữ liệu mẫu bài 1 với cột "ID='TP0019'" và lấy xuống 5 dòng dữ liệu kể từ khi ta tìm được dữ liệu ta được kết quả:

1607583788425.png
Code sẽ như sau:

Rich (BB code):
Sub TimDL_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
        .Find "ID='TP0019'"
        Sheet2.Range("A2").CopyFromRecordset .DataSource, 5
    End With
End Sub
 
Lần chỉnh sửa cuối:
Em thử code sau nhé.

Mã:
Private Sub CommandButton1_Click()
    'Dim arr As Variant
    'arr = ListBox1.List
    'Sheet1.Range("K2:M100").ClearContents
    'Sheet1.Range("K2:M" & rst.RecordCount + 1) = arr
    Sheet1.Range("K2:M1000").ClearContents
    Dim rng  As Range, i As Integer, col As Integer
    Set rng = Worksheets("Sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1)
     For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            For col = 0 To ListBox1.ColumnCount - 1
                rng.Offset(, col).Value = ListBox1.List(i, col)
            Next
            Set rng = rng.Offset(1)
            ListBox1.Selected(i) = False
        End If
    Next

End Sub
Anh Hai Lúa cho OT hỏi chỗ nay với ạ, khi OT muốn hiển thì toàn bộ dữ liệu khi mở form,do đó trong câu lệnh:
Mã:
Private Sub UserForm_Initialize()
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
    TextBox1.Text = "001"
End Sub
OT đã sửa:
TextBox1.Text = "001"
Thành:
TextBox1.Text = ""
Thì khi mở from lên không xuất hiện dữ liệu, vậy làm thế nào để có thể hiển thị toàn bộ dữ liệu khi mở form mã TextBox1="" ạ.
Bởi vì OT thấy sau khi mở Form mã xóa toàn bộ dữ liệu trong TextBox1 thì mới hiển thì toàn bộ danh sách anh ạ.
 
Anh Hai Lúa cho OT hỏi chỗ nay với ạ, khi OT muốn hiển thì toàn bộ dữ liệu khi mở form,do đó trong câu lệnh:
Mã:
Private Sub UserForm_Initialize()
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName, 1
    TextBox1.Text = "001"
End Sub
OT đã sửa:
TextBox1.Text = "001"
Thành:
TextBox1.Text = ""
Thì khi mở from lên không xuất hiện dữ liệu, vậy làm thế nào để có thể hiển thị toàn bộ dữ liệu khi mở form mã TextBox1="" ạ.
Bởi vì OT thấy sau khi mở Form mã xóa toàn bộ dữ liệu trong TextBox1 thì mới hiển thì toàn bộ danh sách anh ạ.
Đã có luôn rồi mà em

Rich (BB code):
Private Sub TextBox1_Change()
    Dim arr As Variant
    If TextBox1.Text = "" Then
        rst.Filter = 0
    Else
        rst.Filter = "Code like '*" & TextBox1.Text & "*'"
    End If
    If rst.EOF Then
        ListBox1.Clear
    Else
        arr = rst.getrows()
        ListBox1.ColumnCount = rst.Fields.Count
        ListBox1.Column = arr
    End If
End Sub
 
Đã có luôn rồi mà em

Rich (BB code):
Private Sub TextBox1_Change()
    Dim arr As Variant
    If TextBox1.Text = "" Then
        rst.Filter = 0
    Else
        rst.Filter = "Code like '*" & TextBox1.Text & "*'"
    End If
    If rst.EOF Then
        ListBox1.Clear
    Else
        arr = rst.getrows()
        ListBox1.ColumnCount = rst.Fields.Count
        ListBox1.Column = arr
    End If
End Sub
Dạ vâng anh, đúng là có rồi ạ nhưng chỉ có tác dụng với, sự kiện: TextBox1_Change
Còn vấn đề OT hỏi là khi mở form lên có luôn cơ ạ (nghĩa là lúc chưa cần tác động lên TextBox1) anh ạ.
 
Dạ vâng anh, đúng là có rồi ạ nhưng chỉ có tác dụng với, sự kiện: TextBox1_Change
Còn vấn đề OT hỏi là khi mở form lên có luôn cơ ạ (nghĩa là lúc chưa cần tác động lên TextBox1) anh ạ.
Thì em nạp bình thường giống như trên Textbox thôi mà

Mã:
Private Sub UserForm_Initialize()
    Dim arr As Variant
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
    'TextBox1.Text = "001"
    If rst.EOF Then
        ListBox1.Clear
    Else
        arr = rst.getrows()
        ListBox1.ColumnCount = rst.Fields.Count
        ListBox1.Column = arr
    End If
End Sub
 
Thì em nạp bình thường giống như trên Textbox thôi mà

Mã:
Private Sub UserForm_Initialize()
    Dim arr As Variant
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
    'TextBox1.Text = "001"
    If rst.EOF Then
        ListBox1.Clear
    Else
        arr = rst.getrows()
        ListBox1.ColumnCount = rst.Fields.Count
        ListBox1.Column = arr
    End If
End Sub
Được rồi ạ, cảm ơn anh Hai Lúa cảm ơn chú Mỹ. Thì ra vấn đề là nằm ở chỗ rst .
Híc OT cứ loay hoay suốt không biết câu lệnh truy vấn liên quan ở chỗ nào.
 
Thì cũng là link bạn Mạnh đưa lên thôi và cái winsqlite3.dll cũng chỉ dùng để tương tác với SQLite database thôi.
Vậy ứng dụng nó ra sao trong Excel và nếu dùng nó có gì hay hơn so với vụ dùng ADODB để kết nối nguồn dữ liệu Excel mà phải đổi hướng xài nó vậy? Tôi chưa xài tới nó bao giờ vì chưa thấy có nhu cầu trong hiện tại của tôi, nếu bạn Mạnh thấy được tính ứng dụng của nó thì khai sáng cho mọi người nhé hoặc bạn Mạnh tạo cái chủ đề mới giới thiệu về nó và ứng dụng cho mọi người học hỏi.
Em hiện tại đang dùng access làm database để lưu dữ liệu bán hàng ( ~ 30 triệu record / năm), vấn đề với access là nó bị giới hạn ~ 2Gb/file nên em mới tìm hiểu qua SQLite vì nó không bị giới hạn kích thước. Em thấy vẫn dùng ADODB để connect với SQLite3 bình thường nên mọi người bàn luận ở đây vẫn phù hợp mà anh

@Kiều Mạnh , @befaint mình đang muốn import hết dữ liệu của 1 table trong file access qua sqlite3 thông qua VBA - ADOdb thì có cách nào không nhỉ?
 
Em hiện tại đang dùng access làm database để lưu dữ liệu bán hàng ( ~ 30 triệu record / năm), vấn đề với access là nó bị giới hạn ~ 2Gb/file nên em mới tìm hiểu qua SQLite vì nó không bị giới hạn kích thước. Em thấy vẫn dùng ADODB để connect với SQLite3 bình thường nên mọi người bàn luận ở đây vẫn phù hợp mà anh

@Kiều Mạnh , @befaint mình đang muốn import hết dữ liệu của 1 table trong file access qua sqlite3 thông qua VBA - ADOdb thì có cách nào không nhỉ?
Cái nick Kiều Mạnh kia với nick này của tôi là 1 Tôi xài 2 nick ấy ... Rất minh bạch và rành mạch ko thèm nấp danh nick ảo

Tôi gợi ý cho viết thôi nhé chứ kỳ này tôi mất hứng thú rồi ... chắc sau này cũng thế sẻ ko bao giờ viết nữa nếu có chỉ gợi ý cho thôi

1/ Khi bạn biết xài SQL lite đó thì bạn sẻ không phụ thuộc vào ADOx của Ms như mô tả bài 184 khoanh tròn thứ 2
2/ đó là thư viện API để xài được nó bạn phải viết thêm các Hàm phụ khai báo sử dụng API
3/ trên VB6 để xài được nó họ viết ra các hàm phụ trung gian xong call API SQLite thì mới sử dụng được
4/ xem hình nha ... code đó là bên kia địa cầu họ viết đấy ... chịu khó tìm đi là thấy có khi thấy rồi mới thì cũng chưa biết xài ... chịu khó quậy ngang dọc đi xong sẻ ngộ ra là biết xài đừng có nóng vội nói bạy nghe không

xem hình minh họa

1610417341164.png
 
Tôi vận dụng và khai thác cái hàm lọc vào cái form lọc dữ liệu, các bạn có thể tham khảo và tùy biến sử dụng nhé.

Mã:
Dim rst As Object

Private Sub TextBox1_Change()
    Dim arr As Variant
    If TextBox1.Text = "" Then
        rst.Filter = 0
    Else
        rst.Filter = "Code like '*" & TextBox1.Text & "*'"
    End If
    If rst.EOF Then
        ListBox1.Clear
    Else
        arr = rst.getrows()
        ListBox1.ColumnCount = rst.Fields.Count
        ListBox1.Column = arr
    End If
End Sub

Private Sub UserForm_Initialize()
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "Select * from [Sheet1$]", "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
    TextBox1.Text = "001"
End Sub

View attachment 249426
Anh ơi có thể hiển thị được tiêu đề cho listbox trường hợp này này được không?
 

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

Back
Top Bottom