Tìm và lấy dữ liệu trong bảng cell bằng VBA

[hathanh349]

Em mới học VBA nên chưa biết nhiều, nhờ các bác giúp.
em có bảng như trên. khiđiền tên vàoô V2, thì sẽđược kết quả nhưở dưới. các bác giúp em với. Trânthành cảmỏn!

 

[HieuCD]

Em mới học VBA nên chưa biết nhiều, nhờ các bác giúp.
em có bảng như trên. khiđiền tên vàoô V2, thì sẽđược kết quả nhưở dưới. các bác giúp em với. Trânthành cảmỏn!

View attachment 259867

View attachment 259868

Code trong sheet2
Bạn gõ phím nhanh quá, bàn phím bị dính

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sArr(), Res(), gv$, i&, k&, j&, N&, sRow&, sCol&
  If Target.Address = "$V$2" Then
    Application.EnableEvents = False
    i = Range("V" & Rows.Count).End(xlUp).Row
    If i > 2 Then Range("V3:V" & i).ClearContents
    gv = Range("V2").Value
    If gv <> Empty Then
      ReDim Res(1 To 100, 1 To 1)
      sArr = Range("A3:T20").Value
      sRow = UBound(sArr)
      sCol = UBound(sArr, 2)
      For i = 1 To sRow
        For j = 2 To sCol
          If sArr(i, j) = gv Then
            k = k + 1
            Res(k, 1) = sArr(i, 1)
          End If
        Next j
      Next i
    End If
    If k Then Range("V3").Resize(k) = Res
    Application.EnableEvents = True
  End If
End Sub

 

[hathanh349]

Code trong sheet2
Bạn gõ phím nhanh quá, bàn phím bị dính

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sArr(), Res(), gv$, i&, k&, j&, N&, sRow&, sCol&
  If Target.Address = "$V$2" Then
    Application.EnableEvents = False
    i = Range("V" & Rows.Count).End(xlUp).Row
    If i > 2 Then Range("V3:V" & i).ClearContents
    gv = Range("V2").Value
    If gv <> Empty Then
      ReDim Res(1 To 100, 1 To 1)
      sArr = Range("A3:T20").Value
      sRow = UBound(sArr)
      sCol = UBound(sArr, 2)
      For i = 1 To sRow
        For j = 2 To sCol
          If sArr(i, j) = gv Then
            k = k + 1
            Res(k, 1) = sArr(i, 1)
          End If
        Next j
      Next i
    End If
    If k Then Range("V3").Resize(k) = Res
    Application.EnableEvents = True
  End If
End Sub

Cảm ơn bác rất nhiều ah

Bài đã được tự động gộp: 3/6/21

Code trong sheet2
Bạn gõ phím nhanh quá, bàn phím bị dính

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sArr(), Res(), gv$, i&, k&, j&, N&, sRow&, sCol&
  If Target.Address = "$V$2" Then
    Application.EnableEvents = False
    i = Range("V" & Rows.Count).End(xlUp).Row
    If i > 2 Then Range("V3:V" & i).ClearContents
    gv = Range("V2").Value
    If gv <> Empty Then
      ReDim Res(1 To 100, 1 To 1)
      sArr = Range("A3:T20").Value
      sRow = UBound(sArr)
      sCol = UBound(sArr, 2)
      For i = 1 To sRow
        For j = 2 To sCol
          If sArr(i, j) = gv Then
            k = k + 1
            Res(k, 1) = sArr(i, 1)
          End If
        Next j
      Next i
    End If
    If k Then Range("V3").Resize(k) = Res
    Application.EnableEvents = True
  End If
End Sub

bác có thể giúpthêm.để kết quả hiển thị như nàyđược không ah.
Thêm môn ở dòng 1 vào lớp
Em cảm ơn

 

[HieuCD]

Cảm ơn bác rất nhiều ah

Bài đã được tự động gộp: 3/6/21

View attachment 259965bác có thể giúpthêm.để kết quả hiển thị như nàyđược không ah.
Thêm môn ở dòng 1 vào lớp
Em cảm ơn

Chỉnh lại tí xíu

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sArr(), Res(), gv$, i&, k&, j&, N&, sRow&, sCol&
  If Target.Address = "$V$2" Then
    Application.EnableEvents = False
    i = Range("V" & Rows.Count).End(xlUp).Row
    If i > 2 Then Range("V3:V" & i).ClearContents
    gv = Range("V2").Value
    If gv <> Empty Then
      ReDim Res(1 To 100, 1 To 1)
      sArr = Range("A1:T20").Value
      sRow = UBound(sArr)
      sCol = UBound(sArr, 2)
      For i = 3 To sRow
        For j = 2 To sCol
          If sArr(i, j) = gv Then
            k = k + 1
            Res(k, 1) = sArr(i, 1) & " - " & sArr(1, j)
          End If
        Next j
      Next i
    End If
    If k Then Range("V3").Resize(k) = Res
    Application.EnableEvents = True
  End If
End Sub