Tìm kiếm và thay thế dữ liệu linh hoạt bằng Code VBA (3 người xem)

[HeSanbi]

Tôi có mảng dữ liệu là chuỗi, tôi muốn tìm kiếm rồi sắp xếp , thay thế và thêm vào
Ví dụ ở Cột B, Bố và Chán không thuộc động từ, chú thích của "Bố" đã bị sai
tôi muốn Bấm Macro là dữ liệu được sắp xếp dự trên 3 dữ liệu nhập vào ở Ô B8,C8,D8.
mong được sự giúp đỡ từ GPE, xin cám ơn

 

[ndu96081631]

Tôi có mảng dữ liệu là chuỗi, tôi muốn tìm kiếm rồi sắp xếp , thay thế và thêm vào
Ví dụ ở Cột B, Bố và Chán không thuộc động từ, chú thích của "Bố" đã bị sai
tôi muốn Bấm Macro là dữ liệu được sắp xếp dự trên 3 dữ liệu nhập vào ở Ô B8,C8,D8.
mong được sự giúp đỡ từ GPE, xin cám ơn

Đầu tiên khuyên bạn nên bố trí lại dữ liệu như hình:




Như thế mới là CSDL chuẩn, muốn làm gì tiếp theo điều là chuyện không khó. Còn dữ liệu của bạn thì chỉ nhìn chơi chứ mọi thao tác dù là code hay công thức đều vô cùng khó khắn

 

[HieuCD]

Tôi có mảng dữ liệu là chuỗi, tôi muốn tìm kiếm rồi sắp xếp , thay thế và thêm vào
Ví dụ ở Cột B, Bố và Chán không thuộc động từ, chú thích của "Bố" đã bị sai
tôi muốn Bấm Macro là dữ liệu được sắp xếp dự trên 3 dữ liệu nhập vào ở Ô B8,C8,D8.
mong được sự giúp đỡ từ GPE, xin cám ơn

thử với code

Sub GPE()
Dim Arr, Darr, Tu As String, ChuThich As String, Loai As String
Dim k As Integer, n As Integer, i As Long, ik As Long
Darr = Array(Range("B12", Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value, _
        Range("D12", Range("D" & Rows.Count).End(xlUp)).Resize(, 2).Value, _
        Range("F12", Range("F" & Rows.Count).End(xlUp)).Resize(, 2).Value)
Tu = UCase(Range("B8").Value)
ChuThich = Range("C8").Value
Loai = Range("D8").Value
k = (Application.Match(Loai, Range("B10:F10"), 0) + 1) / 2 - 1
For n = 0 To 2
  Arr = Darr(n)
  For i = 1 To UBound(Arr)
    If UCase(Arr(i, 1)) = Tu Then
      If n = k Then
        Arr(i, 2) = ChuThich
        Range("B12").Offset(, n * 2).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
        Exit Sub
      Else
        If i < UBound(Arr) Then
          For ik = i To UBound(Arr) - 1
            Arr(ik, 1) = Arr(ik + 1, 1)
            Arr(ik, 2) = Arr(ik + 1, 2)
          Next ik
          Arr(ik, 1) = Empty
          Arr(ik, 2) = Empty
        End If
        Range("B12").Offset(, n * 2).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
        Arr = Darr(k)
        i = 12 + UBound(Arr)
        Cells(i, k * 2 + 2).Value = Range("B8").Value
        Cells(i, k * 2 + 3).Value = Range("C8").Value
      End If
    End If
  Next i
Next n
End Sub