Kết quả mong muốn là thế nào?Em có 1 file excel gồm 1 cột chứa những dòng dữ liệu : số dạng text, các danh từ cần loại bỏ, các kí tự đặc biệt gắn liền với các danh từ cần loại bỏ, em trình bày hơi lủng củng , mong các anh chị xem ảnh minh họa và file excel để hiểu rõ hơn và giúp em với ạ
dòng màu đậm anh ơi, ý là dòng đậm là dòng kết quả sau khi lọc ra ấy anh, em cần 1 vba hoặc 1 hàm excel nào đó có thể lọc đc cái đó ạ, anh có cả file đính kèm mà anh ơi xem giúp em file đính kèm với
sao lại vậy anh em có đính kèm file mà anh
Bạn thử cái này. Mình thấy ra kết quả đúng với yêu cầu. Còn các vấn đề phát sinh thêm thì chưa lường hết được. hích hích...
Sub Laydulieu()
Dim sArr(), dArr(), tArr(), i As Long, J As Long, TK, K As Long
With Sheet1
sArr = .Range("A2", .Range("A65535").End(3)).Value
tArr = .Range("C2", .Range("C65535").End(3)).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
If sArr(i, 1) <> Empty Then
For J = 1 To UBound(tArr)
TK = UCase(sArr(i, 1)) Like "*" & UCase(tArr(J, 1)) & "*"
If TK = True Then
Exit For
End If
Next J
If TK = False Then
If IsNumeric(sArr(i, 1)) = False Then
K = K + 1
dArr(K, 1) = sArr(i, 1)
End If
End If
End If
Next i
.Range("F2:F1000").ClearContents
.Range("F2").Resize(K, 1) = dArr
End With
End Subanh ơi code gần chuẩn rồi ạ nhưng khi em thử điền 1 số dạng number thì code lỗi ạ, a có thể loại cho em trường hợp ô chứa số không ạ, với lại bỏ cái nút run kia đi được không ạ, mong a chiếu cố giúp em thêm lần nữa ạBạn thử cái này. Mình thấy ra kết quả đúng với yêu cầu. Còn các vấn đề phát sinh thêm thì chưa lường hết được. hích hích...
Mã:Sub Laydulieu() Dim sArr(), dArr(), tArr(), i As Long, J As Long, TK, K As Long With Sheet1 sArr = .Range("A2", .Range("A65535").End(3)).Value tArr = .Range("C2", .Range("C65535").End(3)).Value ReDim dArr(1 To UBound(sArr), 1 To 1) For i = 1 To UBound(sArr) If sArr(i, 1) <> Empty Then For J = 1 To UBound(tArr) TK = UCase(sArr(i, 1)) Like "*" & UCase(tArr(J, 1)) & "*" If TK = True Then Exit For End If Next J If TK = False Then If IsNumeric(sArr(i, 1)) = False Then K = K + 1 dArr(K, 1) = sArr(i, 1) End If End If End If Next i .Range("F2:F1000").ClearContents .Range("F2").Resize(K, 1) = dArr End With End Sub
Bạn thử lại với cái này xem sao:
Sub Laydulieu()
Dim sArr(), dArr(), tArr(), i As Long, J As Long, TK, K As Long
With Sheet1
sArr = .Range("A2", .Range("A65535").End(3)).Value
tArr = .Range("C2", .Range("C65535").End(3)).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
If sArr(i, 1) <> Empty Then
TK = False
For J = 1 To UBound(tArr)
If InStr(UCase(sArr(i, 1)), UCase(tArr(J, 1))) Then
TK = True: Exit For
End If
Next J
If TK = False Then
If IsNumeric(sArr(i, 1)) = False Then
K = K + 1
dArr(K, 1) = sArr(i, 1)
End If
End If
End If
Next i
.Range("F2:F1000").ClearContents
.Range("F2").Resize(K, 1) = dArr
End With
End Subcông thức của nó là gì thế anh , em ko quen dùng cái nút run anh ạ
Vì bạn đanh lấy một phần dữ liệu thỏa mãn điều kiện thì tốt nhất là dùng Sub(Gán Code vào nút bấm). Chứ chuyển sang dạng Function thì không ổn lắm
Bạn gửi cái file với dữ liệu báo lỗi mình xem thử
Huhu anh ơi còn 1 trường hợp khá là thú vị em mới phát hiện ra em cũng k lường trước được việc này đó là từ chinh hoặc chin hoặc thiem hoặc thanh thì code cũng bỏ, nhưng rõ ràng những từ này là khác hẳn nghĩa 3 từ mà em muốn bỏ chi anh em tức là dòng dữ liệu nào có 3 từ đó đứng độc lập riêng 1 mình nó hoặc đứng liền với kí tự đặc biệt còn nếu nó đứng với những từ có nghĩa thì nó lại là 1 từ khác hoàn toàn, a xem lại giúp em với
Đúng là nó bỏ mất thật. Chắc phải cắt Text ra so sánh quá
a thư thả giúp em với , cái này em ko biết 1 tí gì cả
Thử lại cái này xem sao nha Bạn. Sai mình sửa tiếp hehe...
Sub Laydulieu()
Dim sArr(), dArr(), tArr(), KyTu()
Dim i As Long, J As Long, TK, K As Long
Dim Ma As String, m As Long, Tmp
With Sheet1
KyTu = Array(",", "{", ",", "(", "[", "]", "-", "(", ")", ".")
sArr = .Range("A2", .Range("A65535").End(3)).Value
tArr = .Range("C2", .Range("C65535").End(3)).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
If sArr(i, 1) <> Empty Then
Ma = sArr(i, 1)
For J = 0 To UBound(KyTu)
Ma = Replace(Ma, KyTu(J), " ", , 2)
Next J
TK = False
Tmp = Split(Ma, " ")
For J = 1 To UBound(tArr)
For m = 0 To UBound(Tmp)
If UCase(Trim(Tmp(m))) = UCase(Trim(tArr(J, 1))) Then
TK = True: Exit For
End If
Next m
If TK = True Then Exit For
Next J
If TK = False Then
If IsNumeric(sArr(i, 1)) = False Then
K = K + 1
dArr(K, 1) = sArr(i, 1)
End If
End If
End If
Next i
.Range("F2:F1000").ClearContents
.Range("F2").Resize(K, 1) = dArr
End With
End Sub
