• Thứ Hai, 15/03/2004 13:31 (GMT+7)

    Tạo bảng chọn dữ liệu trong Excel

    Lượt xem 26711
    Đánh giá

    Ngoài khả năng xử lý bảng tính, Excel còn có những công cụ tăng hiệu quả công việc, ví dụ như giúp bạn chọn nhanh từ các bảng dữ liệu đồ sộ. Ở đây tôi xin đưa ra một ví dụ nhỏ về việc tạo form để chọn mã sản phẩm từ bảng dữ liệu sản phẩm.

    Ví dụ trong sheet MaSanPham, tôi có bảng mã sản phẩm như hình 1.


                         Hình 1

    Tôi đặt tên cho vùng A2:B570 là MaSanPham. Đánh dấu vùng A2:B570 rồi vào Insert.Name.Define, nhập MaSanPham trong hộp thoại Names in Workbook (hình 2), sau đó nhấn OK.
    Bây giờ đến phần thiết kế form để người dùng chọn mã sản phẩm. Từ cửa sổ Excel bạn nhấn tổ hợp phím Alt+F11. Cửa sổ VBE xuất hiện, sau đó bạn chọn Insert.UserForm. Đặt tên form là frmDataSelector, thuộc tính Caption là Data Selector. Trên form đặt các đối tượng sau: 1 TextBox có tên là TxtCode, 1 nút lệnh cmdOK, 1 nút lệnh là cmdCancel, 1 ListView là LVDataSelector (hình 3). Nếu không có đối tượng ListView trên thanh Toolbox, bạn phải vào Tools.Additional Controls và chọn Microsoft ListView Control.
    Sau đó bạn chọn Insert.Module, đặt tên Module là DataSelector và gõ vào đoạn mã sau:

    Option Explicit
    ''''''''''''''''''''''''''''''''''
    Function RangeNameExists(Nname) As Boolean

    ' Kiểm tra xem tên có tồn tại hay không

    ' Nếu tồn tại thì hàm trả về TRUE

    Dim n As Name

    RangeNameExists = False

    For Each n In ActiveWorkbook.Names

    If UCase(n.Name) = UCase(Nname) Then

    RangeNameExists = True

    Exit Function

    End If

    Next n

    End Function

    ''''''''''''''''''''''''''''''''''
    ' Đây là hàm để xuất các dữ liệu từ bảng đã được đặt tên sang mảng
    ''''''''''''''''''''''''''''''''''
    Function TableToArray(ByVal TableName As String)

    Dim arr

    Dim vRange As Range

    Dim i As Long, j As Long, m As Long, n As Long

    If Not RangeNameExists(TableName) Then Exit Function 'Nếu không tồn tại thì thoát 


                    Hinh 2

    On Error Resume Next

    Set vRange = Range(TableName)

    i = vRange.Rows.count

    j = vRange.Columns.count

    ReDim arr(1 To i, 1 To j)

    For m = 1 To i

    For n = 1 To j

    arr(m, n) = vRange(m, n).Value

    Next n

    Next m

    TableToArray = arr

    Set vRange = Nothing

    End Function

    ''''''''''''''''''''''''''''''''''
    'Chuyển từ mảng sang ListView và định dạng ListView
    ''''''''''''''''''''''''''''''''''

    Sub ArrayToListview(ByVal VlistView As Listview, ByVal InputArray)

    Dim m As Long

    Dim i As Integer, j As Integer

    Dim bHang As Long, bCot As Long, bHeader As Integer

    Dim it As ListItem

    Dim anItem

    If Not IsObject(VlistView) Then Exit Sub

    On Error Resume Next

    'Đếm số hàng và số cột trong InputArray

    bHang = UBound(InputArray, 1)

    bCot = UBound(InputArray, 2)

    'Định dạng ListView

    VlistView.View = lvwReport

    VlistView.FullRowSelect = True

    VlistView.MultiSelect = False

    VlistView.Gridlines = True

    VlistView.LabelEdit = lvwManual

    VlistView.HideColumnHeaders = True

    bHeader = VlistView.ColumnHeaders.count

    Select Case bHeader 'Xác định số cột của ListView

    Case Is < bCot

    For i = bHeader + 1 To bCot

    VlistView.ColumnHeaders.Add i

    Next i

    Case Is = bCot

    'Do nothing
     


                            Hình 3

    Case Is > bCot

    'Do nothing

    End Select

    'Điền các giá trị từ Inputarray vao Listview

    For i = 1 To bHang

    For j = 1 To bCot

    anItem = InputArray(i, j)

    If j = 1 Then

    Set it = VlistView.ListItems.Add()

    it.Text = anItem

    Else

    it.SubItems(j - 1) = anItem

    End If

    Next j

    Next i

    'Đặt chiều rộng các cột

    For i = 1 To bCot

    VlistView.ColumnHeaders(i).Width = 150

    Next i

    Set it = Nothing

    Exit Sub

    Tbloi:

    MsgBox 'Xin lỗi, không thể đưa mảng vào Listview ' , vbCritical, 'Thông báo'

    End Sub

    ''''''''''''''''''''''''''''''''''
    'Đưa từ bảng vào mảng, sau đó đưa từ mảng vào ListView
    'Và dĩ nhiên bạn cũng có thể chuyển từ bảng vào ListView

    Sub NhapDuLieu()

    On Error Resume Next

    Call DataSelector('MaVatTu')

    End Sub

    Sub DataSelector(Tenbang As String)

    Dim bMang1

    On Error Resume Next

    bMang1 = TableToArray(Tenbang)

    Call ArrayToListview(frmDataSelector.LVDataSelector, bMang1)

    frmDataSelector.Show

    End Sub

    Đoạn mã của frmDataSelector như sau:

    Private Sub cmdCancel_Click()

    Unload Me 'Thoát

    End Sub

    Private Sub cmdOK_Click()

    Dim bGiatrichon

    On Error Resume Next

    bGiatrichon = LVDataSelector.SelectedItem.Text

    ActiveCell.Value = bGiatrichon 'Đặt giá trị bạn chọn vào ô hiện tại

    End Sub 


                                 Hình 4

    'Mục đích của hàm sau nhằm cuộn danh sách trong ListView đến mã tương tự trong 'danh sách khi người sử dụng gõ vào 'Textbox txtCode các ký tự đầu tiên của mã.

    Private Sub txtCode_Change()

    Dim it As ListItem

    On Error Resume Next

    btim = Me.txtCode.Text

    Set it = Me.LVDataSelector.FindItem(btim, lvwText, , lvwPartial)

    bindex = it.Index

    Me.LVDataSelector.ListItems.Item(bindex).Selected = True

    Me.LVDataSelector.ListItems.Item(bindex).EnsureVisible

    Set it = Nothing

    End Sub


                      Hinh 5

    Giả sử bây giờ muốn lấy mã sản phẩm từ bảng MaSanPham, trong sheet MaSanPham, khi nhấn chuột phải ở cột 1 của Sheet2 thì đoạn mã trong Sheet2 như sau (hình 4):

    Private Sub Worksheet_BeforeRightClick (ByVal Target As Range, Cancel As _ Boolean)

    If Target.Column = 1 Then

    Cancel = True

    Call NhapDuLieu

    End If

    End Sub

    (Xem hình 5)
    Bây giờ bạn hãy trở về cửa sổ Excel, chọn một ô bất kỳ ở cột 1 của Sheet2, nhấn chuột phải thì sẽ có form Data Selector hiện ra như hình 5, bạn hãy thử gõ vào các ký tự đầu tiên của mã sản phẩm bạn cần... và sẽ thấy nó hoạt động như thế nào.
    Chúc các bạn thành công. Mọi ý kiến góp ý bạn gửi về địa chỉ email của tác giả.ÿ

    Lê Văn Duyệt
    levanduyet@pmail.vnn.vn

     

    ID: A0401_99
    Tin ngày :

Thuật ngữ