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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Nhattanktnn đã viết:
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
Nhấp chuột vào đây để mở rộng...
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.
 
Nhattanktnn đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
NHN_Phương đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đã 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
 
Hai Lúa Miền Tây đã viết:
Đã 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
Nhấp chuột vào đây để mở rộng...
Ô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
 
Hai Lúa Miền Tây đã viết:
Đã 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
Nhấp chuột vào đây để mở rộng...
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
 
NHN_Phương đã viế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
Nhấp chuột vào đây để mở rộng...
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
 
Nhattanktnn đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
NHN_Phương đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
NHN_Phương đã viết:
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
Nhấp chuột vào đây để mở rộng...
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.
 
Hai Lúa Miền Tây đã viết:
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ấp chuột vào đây để mở rộ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
 
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ
 
MinhKhai đã viết:
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
Nhấp chuột vào đây để mở rộng...

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.

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

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

Hai Lúa Miền Tây đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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:

befaint đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đú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 và @ongke0711
 
Lần chỉnh sửa cuối:
MinhKhai đã viết:
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).
Nhấp chuột vào đây để mở rộng...

:) 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
 
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
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?
 
NHN_Phương đã viết:
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?
Nhấp chuột vào đây để mở rộng...
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é.
 
MinhKhai đã viết:
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 ?
Nhấp chuột vào đây để mở rộng...

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

Hai Lúa Miền Tây đã viết:
Chần chừ gì nữa chia sẻ đi bạn.
Nhấp chuột vào đây để mở rộng...

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:
ongke0711 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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ỉ ?
 
ongke0711 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
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.
 
Hai Lúa Miền Tây đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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.
 
Hai Lúa Miền Tây đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Mới thử xong nó chạy kẹt cứng chuột luôn không thoát được
 
ongke0711 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Bạn chỉnh lại độ trể thời gian xem thế nào nhé.
phuongnam366377 đã viết:
Mới thử xong nó chạy kẹt cứng chuột luôn không thoát được
Nhấp chuột vào đây để mở rộng...
Đú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
 
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Hai Lúa Miền Tây đã viết:
Khai thác và đưa lên thử đi anh.
Nhấp chuột vào đây để mở rộng...
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
 
Hai Lúa Miền Tây đã viết:
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*'"
 ...
Nhấp chuột vào đây để mở rộng...

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.
 
ongke0711 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Đượ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
 
Hai Lúa Miền Tây đã viết:
Đượ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"
Nhấp chuột vào đây để mở rộng...

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

Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
Mạnh biết mà .... HLMT biết lâu ròi có điều chưa có viết đó thôi
 
thuyyeu99 đã viết:
Hay nhỉ, học được 1 chiêu Filter . Anh number one:thumbs:
Nhấp chuột vào đây để mở rộng...
Múa rìu qua mắt thợ thôi em.
phuongnam366377 đã viết:
Mạnh biết mà .... HLMT biết lâu ròi có điều chưa có viết đó thôi
Nhấp chuột vào đây để mở rộng...
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

Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
NHN_Phương đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộ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

Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
Ô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.
 
NHN_Phương đã viết:
Ô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.
Nhấp chuột vào đây để mở rộng...
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é.
 
Hai Lúa Miền Tây đã viết:
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é.
Nhấp chuột vào đây để mở rộng...
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.
 
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
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:
NHN_Phương đã viết:
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
Nhấp chuột vào đây để mở rộng...
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é.
 
Hai Lúa Miền Tây đã viết:
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é.
Nhấp chuột vào đây để mở rộng...
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
 
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
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ó
 
Hai Lúa Miền Tây đã viết:
Trong CSDL Excel thì nó có giới hạn không cho xóa nhé em.
Nhấp chuột vào đây để mở rộng...
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.
 
Tuanba1992 đã viết:
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
Nhấp chuột vào đây để mở rộng...

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:
ongke0711 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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>
 
Hai Lúa Miền Tây đã viết:
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>
Nhấp chuột vào đây để mở rộng...
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ộ ?!
 
Kiều Mạnh đã viết:
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ộ ?!
Nhấp chuột vào đây để mở rộng...
Đang khai thác Recordset mà anh. Vậy nên mình phải lấy từ Recordset.
 
Kiều Mạnh đã viết:
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
Nhấp chuột vào đây để mở rộng...
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ứ.
 
Hai Lúa Miền Tây đã viết:
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>
Nhấp chuột vào đây để mở rộng...
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é.
 
Hai Lúa Miền Tây đã viết:
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ấp chuột vào đây để mở rộng...
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
 
Kiều Mạnh đã viết:
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
Nhấp chuột vào đây để mở rộng...
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:
Kiều Mạnh đã viết:
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)
Nhấp chuột vào đây để mở rộng...

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

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:
ongke0711 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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ế.
 
befaint đã viết:
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ế.
Nhấp chuột vào đây để mở rộng...
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:
Kiều Mạnh đã viết:
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)
Nhấp chuột vào đây để mở rộng...

Đồ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.
 
ongke0711 đã viết:
Đồ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.
Nhấp chuột vào đây để mở rộng...
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
 
Kiều Mạnh đã viế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
Nhấp chuột vào đây để mở rộng...

: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:
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
NHN_Phương đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
Đã 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
 
Hai Lúa Miền Tây đã viết:
Đã 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
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
NHN_Phương đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
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
 
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đượ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.
 
ongke0711 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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ỉ?
 
evolt đã viết:
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ỉ?
Nhấp chuột vào đây để mở rộng...
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
 
Hai Lúa Miền Tây đã viết:
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
Nhấp chuột vào đây để mở rộng...
Anh ơi có thể hiển thị được tiêu đề cho listbox trường hợp này này được không?
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

S
cần xử lý dữ liệu trùng nhau bằng VBA
    • Cười
Trả lời
2
Đọc
40
SA_DQ
SA_DQ
N
Tạo file lưu trữ dữ liệu tự động trên excel.
Trả lời
7
Đọc
120
le_vis
L
N
  • Question Question
Tạo file lưu trữ dự liệu tự động
Trả lời
6
Đọc
134
Hoàng Tuấn 868
H
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
513
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn (1 người xem)
Trả lời
3
Đọc
135
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết (1 người xem)
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ
Trả lời
4
Đọc
101
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
76
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN (1 người xem)
Trả lời
2
Đọc
73
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb (1 người xem)
Trả lời
6
Đọc
300
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
615
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
149
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng
Trả lời
1
Đọc
131
HUONGHCKT
H
Xem thêm…

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

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

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

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