win-sun
Thành viên hoạt động
- Tham gia
- 19/1/09
- Bài viết
- 151
- Được thích
- 15
Ý 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:- 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:- 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!!
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
Hiểu chết liền!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
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ứcon trỏ chuột thầy ơi!
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
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
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
Private Sub ComboBox1_Click()
On Error Resume Next
ActiveCell = ComboBox1.List(ComboBox1.ListIndex, 0)
End Sub
Private Sub ComboBox1_DropButtonClick()
With ComboBox1
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
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
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
File này chưa xong đâu! Theo tôi còn phải cải tiến thêm đấyCả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ảm ơn bạn... nhưng tôi ở Biên Hòa Đồng Nai!- 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
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2