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

Liên hệ QC
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

  • FormLoc.xlsm
    24.1 KB · Đọc: 50
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

  • FormLoc.xlsm
    26 KB · Đọc: 40
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

  • FormLoc.xlsm
    27.6 KB · Đọc: 42
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
 
Web KT
Back
Top Bottom