Giúp dời ô tìm kiếm kiểu xổ list gợi ý sang ô khác (1 người xem)

[chaoban888]

Em có 1 file tìm kiếm xổ list gợi ý nhưng em muốn mấy ô đó nằm ở cột B thì phải chỉnh sửa code thế nào ạ ?

 

[giaiphap]

Trong code sau, bạn thay Target.Column = 1 thành Target.Column = 2 là được.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Column = 1 Then 'Thay số 1 ở dòng này thành số 2 là được.
  If Target.Row > 1 And Target.Row < 1000 And Target.Count = 1 Then
    If Target = "" Then
         thaydoi
      Else
         Hide
    End If
  End If
Else
  Hide
End If
Application.ScreenUpdating = True
End Sub

 

[chaoban888]

Cảm ơn bác nhé

 

[chaoban888]

Sub loc()
Dim dl(), i As Long, c As Byte
dl = Sheet2.[B2:B1000].Value
ActiveSheet.ListBox1.Clear
c = ActiveCell.Column
For i = 1 To UBound(dl)
   If dl(i, c) <> "" Then
      If TV(dl(i, c)) Like TV("*" & ActiveSheet.TextBox1.Value & "*") Then
         ActiveSheet.ListBox1.AddItem dl(i, c)
      End If
   End If
Next
End Sub

Mình chuyển cột B thì nó lại báo lỗi ở đây là sao vậy nhỉ ?

 

[giaiphap]

Sub loc()
Dim dl(), i As Long, c As Byte
dl = Sheet2.[B2:B1000].Value
ActiveSheet.ListBox1.Clear
c = ActiveCell.Column
For i = 1 To UBound(dl)
   If dl(i, c) <> "" Then
      If TV(dl(i, c)) Like TV("*" & ActiveSheet.TextBox1.Value & "*") Then
         ActiveSheet.ListBox1.AddItem dl(i, c)
      End If
   End If
Next
End Sub

Mình chuyển cột B thì nó lại báo lỗi ở đây là sao vậy nhỉ ?

Bạn sửa lại thế này.

Sub loc()
Dim dl(), i As Long, c As Byte
dl = Sheet2.[B2:B1000].Value
ActiveSheet.ListBox1.Clear
'c = ActiveCell.Column
For i = 1 To UBound(dl)
   If dl(i, 1) <> "" Then
      If TV(dl(i, 1)) Like TV("*" & ActiveSheet.TextBox1.Value & "*") Then
         ActiveSheet.ListBox1.AddItem dl(i, 1)
      End If
   End If
Next
End Sub