Khai thác và tùy biến thêm, sửa, xuất file và lấy dữ liệu từ Recordset

Hai Lúa Miền Tây · 16/11/20

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

thuyyeu99 · 16/11/20

Hay nhỉ, học được 1 chiêu Filter . Anh number one :thumbs:

phuongnam366377 · 16/11/20

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

Mạnh biết mà .... HLMT biết lâu ròi có điều chưa có viết đó thôi

Hai Lúa Miền Tây · 16/11/20

thuyyeu99 đã viết:
Hay nhỉ, học được 1 chiêu Filter . Anh number one

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

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

Hoàng Nhật Phương · 16/11/20

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

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

phuongnam366377 · 16/11/20

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

Hai Lúa Miền Tây · 16/11/20

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

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

Hoàng Nhật Phương · 16/11/20

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

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

Hai Lúa Miền Tây · 16/11/20

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.

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

ongke0711 · 16/11/20

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

Ra tay làm demo luôn đi bạn.

Hoàng Nhật Phương · 16/11/20

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

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.

Hoàng Nhật Phương · 16/11/20

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

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.

Hai Lúa Miền Tây · 16/11/20

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

Biết ngay sẽ có câu hỏi này

. Em thử tìm cách khắc phục nhé.

Hai Lúa Miền Tây · 17/11/20

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

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

Hoàng Nhật Phương · 17/11/20

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

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.

Hai Lúa Miền Tây · 17/11/20

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

Hoàng Nhật Phương · 17/11/20

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

Thêm sửa và xóa nữa đi anh Hai Lúa ơi :-=

Hai Lúa Miền Tây · 17/11/20

NHN_Phương đã viết:
Thêm sửa và xóa nữa đi anh Hai Lúa ơi

Trong CSDL Excel thì nó có giới hạn không cho xóa nhé em.

Tuanba1992 · 17/11/20

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

ptm0412 · 17/11/20

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.

Thay vì xoá thì "sửa" thành null tất cả field

Khai thác và tùy biến thêm, sửa, xuất file và lấy dữ liệu từ Recordset

❆❆❆❆❆❆❆❆

File đính kèm

Trùm Nhiều Chuyện

Thành viên hoạt động

❆❆❆❆❆❆❆❆

File đính kèm

Thành viên gắn bó

Thành viên hoạt động

❆❆❆❆❆❆❆❆

File đính kèm

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

❆❆❆❆❆❆❆❆

❆❆❆❆❆❆❆❆

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Thành viên mới

Bad Excel Member