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 SubANH ƠI CODE SẮP OK RỒI EM TÉT KĨ RỒI ĐC TẦM 99% RỒI CÒN 1 CÁI NÀY NỮA THÔI Ạ , ĐÓ LÀ LÚC ĐẦU EM CÓ YÊU CẦU LÀ NHỮNG TỪ CẦN BỎ QUA MÀ ĐI KÈM VỚI NHỮNG KÍ TỰ , { () [ ]- . " GẶP LÀ BỎ, GIỜ ANH BỔ SUNG THÊM CHO EM 9 KÍ TỰ NÀY NỮA LÀ OK Ạ : _ \ / + " : ; ' MÀ NẾU ANH LÀM ĐC TỔNG QUÁT TẤT CẢ CÁC KÍ TỰ ĐẶC BIỆT FULL THÌ OK Ạ , CÒN KHÔNG THÌ CỨ THÊM 9 CÁI NÀY NỮA LÀ CÁI CODE NÀY ĐẸP ANH Ạ ( TỨC LÀ CÁC TỪ CẦ BỎ QUA CỨ ĐỨNG LIỀN VỚI NHỮNG KÍ TỰ NÀY THÌ BỎ )
Bạn thay cái KyTu cũ bằng cái này:
KyTu = Array(",", "{", "}", "[", "]", "-", "(", ")", ".", "_", "\", "/", "+", ":", ";", "'", """")Nếu mà gặp các ký tự đặc biệt là xét thành 1 điều kiện để bỏ không lấy thì Code khác chứ không phải như trên nữa rồi (Cái trên chỉ căn cứ vào điều kiện là không thuộc vùng C2 đến C... và không phải là số)
ý anh là sao ạ, em k hiểu lắm
Ví dụ như thế này:
nếu em thêm từ mot vào cột C thì đúng là ko xét mà anh , em thêm từ nào vào cột C thi no k xet
Bạn thư bấm nút Run1 và Run2 để kiểm tra kết quả
cái Dau nành loai [mot] có vi phạm gì đâu anh từ mot không phải từ cần loại bỏ vì em ko thêm nó vào cột C mà hiện tại em chỉ thêm 3 từ là anh, chi, em, a đang làm em rất rối
Bạn thay cái dòng .Range("F2").Resize(K, 1) = dArr cũ thành
If K Then
.Range("F2").Resize(K, 1) = dArr
Else
MsgBox "Khong tim thay du lieu"
End If
