VuCongThanhNHNo
Thành viên mới

- Tham gia
- 4/4/21
- Bài viết
- 4
- Được thích
- 1
Trong khi chờ các giải pháp khác ,E cần so sánh dữ liệu trong cột A với cột B. Nếu dữ liệu trong cột A có xuất hiện trong chuỗi ký tự ở cột B trả về giá trị cột C ạ.
Mong các bác giúp đỡ ạ.
Sub demo1()
Dim i&, j&, Lr&, t&
Dim Arr(), KQ()
Dim Ws As Worksheet
Dim Dic As Object, Temp
Set Ws = Sheet1
Lr = Ws.Cells(1000000, 1).End(3).Row
Arr = Ws.Range("A1:C" & Lr).Value
ReDim KQ(1 To UBound(Arr), 1 To 4)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Not Dic.Exists(Arr(i, 1)) Then Dic.Add (Arr(i, 1)), i
Next i
For j = 1 To UBound(Arr)
If Arr(j, 2) <> Empty Then
Temp = "*" & Arr(j, 2) & "*"
If Dic.Exists(Temp) Then
t = t + 1
KQ(t, 1) = t
KQ(t, 2) = Arr(Dic.Item(Temp), 1)
KQ(t, 3) = Temp
KQ(t, 4) = Arr(j, 3)
End If
End If
Next j
Ws.Range("E2").Resize(t, 4) = KQ
Set Dic = Nothing
MsgBox "Done"
End Sub
Sub CompareColumns()
Dim ws As Worksheet
Dim rngA As Range, rngB As Range
Dim i As Long, j As Long
' Chọn worksheet bạn muốn làm việc
Set ws = ThisWorkbook.Sheets("Sheet1")
' Thiết lập phạm vi cho cột A và B
Set rngA = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set rngB = ws.Range("B1:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
' Duyệt qua từng dòng trong cột B
For i = 1 To rngB.Rows.Count
' Duyệt qua từng dòng trong cột A
For j = 1 To rngA.Rows.Count
' So sánh giá trị cột A với chuỗi ký tự cột B
If InStr(1, rngB.Cells(i, 1).Value, rngA.Cells(j, 1).Value, vbTextCompare) > 0 Then
' Nếu giá trị cột A xuất hiện trong chuỗi ký tự cột B, ghi Đúng vào cột C và thoát vòng lặp
rngB.Cells(i, 2).Value = "Đúng"
Exit For
Else
' Nếu không, ghi Sai vào cột C
rngB.Cells(i, 2).Value = "Sai"
End If
Next j
Next i
End Sub