xin code selection change!

Liên hệ QC

win-sun

Thành viên hoạt động
Tham gia
19/1/09
Bài viết
151
Được thích
15
- Nhờ giúp đỡ selection change
* em có sheet ds nhân viên và sheet nhập sử dụng selection change, phía trước combobox em gõ tên nhân viên, em muốn combobox sẽ sổ xuống danh sácg nhân viên có tên tại cột B phía trước, xin chân thành cảm ơn!!
 

File đính kèm

  • DM_CBCNV.7z
    72.9 KB · Đọc: 42
- Nhờ giúp đỡ selection change
* em có sheet ds nhân viên và sheet nhập sử dụng selection change, phía trước combobox em gõ tên nhân viên, em muốn combobox sẽ sổ xuống danh sácg nhân viên có tên tại cột B phía trước, xin chân thành cảm ơn!!
Ý bạn là khi chọn tên thì combobox sẽ chọn danhsach mà gồm những tên đó. Theo tôi có những bất tiện sau:
1/ Tôi thấy sự kiện là C7:C1000 mà bạn lại nhập ở cột B.
2/ Sự kiện change này có lúc không làm thay đổi ListFillRange của combobox.
3/ Vậy từ dòng 7 -> 1000 bạn phải tạo từng ấy CB.
4/ Đã làm VBA thì cần gì làm ct.
Vậy chuyển sang ListBox được không. Chỉ cần 1 form duy nhất và đảm bảo sẽ thay đổi theo cột B.
 
Upvote 0
Hóa ra cũng nhiêu khê nhỉ! mình chỉ nghỉ đơn giản vấn đề là xác định lại vị trí của combobox đang ở hàng thứ mấy thì list sẽ thay đổi theo rồi và chỉ việc lấy theo list mới này thôi chứ. xin cảm ơn
 
Upvote 0
- Nhờ giúp đỡ selection change
* em có sheet ds nhân viên và sheet nhập sử dụng selection change, phía trước combobox em gõ tên nhân viên, em muốn combobox sẽ sổ xuống danh sácg nhân viên có tên tại cột B phía trước, xin chân thành cảm ơn!!
Sửa code SelectionChange của bạn thành:
Mã:
Sub Worksheet_SelectionChange(ByVal Target As Range)
  With ComboBox1
   If Not Intersect([C7:C1000], Target) Is Nothing And Target.Count = 1 Then
      [COLOR=red][B].ListFillRange = "'DANH SACH'!" & Evaluate("list").Address[/B][/COLOR]
      .Visible = True
      .Top = Target.Top
      .Height = Target.Height
    ElseIf Application.CutCopyMode = False Then
      .Visible = False
    End If
  End With
End Sub
Chổ màu đỏ là dòng mới thêm vào
 
Upvote 0
Thầy ơi sao ở sheet nhập khi nhập liệu nó cứ thục xuống dưới hoài , mỗi lần combo thay đổi là nó biến xuống dưới luôn
 
Upvote 0
con trỏ chuột thầy ơi!
 
Upvote 0
con trỏ chuột thầy ơi!
Tôi vẫn không phát hiện có điều gì bất thường cả ---> Chắc máy bạn nó sao ấy chứ
------------------
Hôm nay rảnh, ta cùng bàn lại bài toán này
- Ở sheet DANH SACH, bạn tốn nguyên 1 cột phụ để tách tên (chỉ dùng để sort)
- Thêm 1 cột phụ dùng COUNTIF chẳng biết để làm gì
- Tốn 1 name động để nạp list cho ComboBox (mà cũng không mấy hiệu quả)
Tôi làm lại cho bạn theo hướng khác: bỏ hết các cột phụ ở 2 sheet ---> Tại sheet nhập, bạn chỉ cần chọn cell, bấm mũi tên xổ xuống của ComboBox, nhập từ gợi nhớ vào là danh sách sẽ tự lọc
Đúng ra bài này ta dùng mảng là hợp lý nhất, nhưng hôm nay muốn giới thiệu cho bạn 1 phương pháp mới (hình như chưa thấy ai xài) ---> Dùng OWC11.Spreadsheet Object, nó thay thế cho mảng để lưu trử những gì ta lọc được, sau đó sẽ nạp vào ComboBox
1> Trong Module: Tạo 2 UDF
PHP:
Function NameLookUp(ByVal sName As String, ByVal sRng As Range, iType As String)
  Dim TmpArr, Tmp As String, i As Long, j As Long, n As Long, m As Long
  TmpArr = sRng
  If sName = "" Then NameLookUp = sRng: Exit Function
  With CreateObject("OWC11.Spreadsheet")
    For i = 1 To UBound(TmpArr, 1)
      Tmp = NameSep(CStr(TmpArr(i, 1)), iType)
      If InStr(1, UCase(Tmp), UCase(sName)) = 1 Then
        n = n + 1: m = 0
        For j = 1 To UBound(TmpArr, 2)
          m = m + 1
          .Cells(n, m) = TmpArr(i, j)
        Next
      End If
    Next
    NameLookUp = .Range("A1").CurrentRegion
  End With
End Function
PHP:
Function NameSep(ByVal sName As String, ByVal iType As String) As String
  Dim Temp, Item1 As String, Item2 As String, Item3 As String
  sName = WorksheetFunction.Trim(sName)
  Temp = Split(sName, " ")
  If sName = "" Then
    NameSep = ""
  Else
    Item3 = Temp(UBound(Temp))
    Item1 = Temp(0)
    Item2 = Trim(Replace(Replace(sName, Item1, ""), Item3, ""))
    Select Case UCase(iType)
      Case "FNAME": NameSep = IIf(UBound(Temp) > 0, Item1, "")
      Case "MNAME": NameSep = IIf(UBound(Temp) > 1, Item2, "")
      Case "LNAME": NameSep = Item3
    End Select
  End If
End Function
2> Trong Sheet NHAP
PHP:
Private Sub ComboBox1_Change()
  Dim Arr
  On Error Resume Next
  With Sheet1.Range("A6").CurrentRegion
    Arr = NameLookUp(ComboBox1.Text, Intersect(.Cells, .Offset(1)), "LName")
    ComboBox1.List() = Arr
  End With
End Sub
PHP:
Private Sub ComboBox1_Click()
  On Error Resume Next
  ActiveCell = ComboBox1.List(ComboBox1.ListIndex, 0)
End Sub
PHP:
Private Sub ComboBox1_DropButtonClick()
  With ComboBox1
    .SelStart = 0
    .SelLength = Len(.Text)
  End With
End Sub
PHP:
Sub Worksheet_SelectionChange(ByVal Target As Range)
  With ComboBox1
    If Not Intersect([B7:B1000], Target) Is Nothing And Target.Count = 1 Then
      If Application.CutCopyMode = False Then
        .Visible = True
        .Top = Target.Top: .Left = Target.Left
        .Width = Target.Width: .Height = Target.Height
        .Text = NameSep(Target, "LName")
      End If
    ElseIf Application.CutCopyMode = False Then
      .Visible = False
    End If
  End With
End Sub
PHP:
Sub Worksheet_Change(ByVal Target As Range)
  Dim Clls As Range, FRng As Range
  On Error Resume Next
  If Not Intersect([B7:B1000], Target) Is Nothing Then
    For Each Clls In Target
      If Clls.Value = "" Then
        Clls(, 2).Resize(, 2).Value = ""
      Else
        Set FRng = Sheet1.Range("A5").CurrentRegion.Resize(, 1).Find(Clls, , xlValues, xlWhole)
        If Not FRng Is Nothing Then Clls(, 2).Resize(, 2).Value = FRng(, 2).Resize(, 2).Value
      End If
    Next
  End If
End Sub
Hãy thí nghiệm trên file đính kèm xem có tiện dụng không nha
Đừng xem thường cái thằng OWC11.Spreadsheet Object này nha! Thậm chí nó có thể lấy dữ liệu trên 1 file khác (đang đóng) nhanh như trở bàn tay mà code lại cực ngắn đấy ---> Tự nghiên cứu thêm đi
 

File đính kèm

  • DM_CBCNV.rar
    63.6 KB · Đọc: 102
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn thầy rất nhiều, thầy lúc nào cũng nhiệt tình giúp đỡ mọi người, nhờ có thầy các file làm việc của em ngày càng thuận tiện và em rất thích thú lvới công việc.ước gì trình độ em được như thầy nhỉ!
- Khi nào có dịp thầy cho em diện kiến được không!
- Thầy đang ở HN hay HCM vậy
 
Upvote 0
Cảm ơn thầy rất nhiều, thầy lúc nào cũng nhiệt tình giúp đỡ mọi người, nhờ có thầy các file làm việc của em ngày càng thuận tiện và em rất thích thú lvới công việc
File này chưa xong đâu! Theo tôi còn phải cải tiến thêm đấy
Thử nghĩ thế này:
- Bạn đang dùng Find để tìm theo tên
- Find Method chỉ tìm Item nào gần nhất mà nó phát hiện
- Trong trường hợp có 2 tên trùng nhau (ví dụ: Nguyễn Thị Tuyết) ---> Vậy bạn làm cách nào để chọn được Nguyễn Thị Tuyết thứ 2 ---> Vì cho dù tay bạn có chọn Item thứ 2 trong ComboBox thì Find Method cũng sẽ tìm em thứ nhất mà thôi
- Nghĩ thử xem, liệu có phải ta nên cải tiến lại bằng cách dùng Find tìm theo MÃ NHÂN VIÊN hay không? (vì đây là list duy nhất)
---------------------------------------
- Khi nào có dịp thầy cho em diện kiến được không!
- Thầy đang ở HN hay HCM vậy
Cảm ơn bạn... nhưng tôi ở Biên Hòa Đồng Nai!
 
Upvote 0
Web KT
Back
Top Bottom