LinDan
Thành viên tiêu biểu

- Tham gia
- 8/2/12
- Bài viết
- 412
- Được thích
- 111
Yêu cầu của bài toán là trích lọc toàn bộ các ô có chứa từ GPE từ cột A (kết quả điền minh họa ở cột B)
Bài này làm bằng VBA trên diễn đàn đã có rất nhiều, tuy vậy tôi muốn biết cách làm theo công thức như thế nào? Xin hãy chỉ giúp
Xin lỗi, ô minh họa kết quả tôi không cập nhật hết trường hợp ô A6 (343GPE345) cũng được trích lọc ra, nghĩa là GPE có thể xuất hiện bất kỳ không nhất thiết nằm ở bên trái.
Rất mong bác giúp cho trường hợp này
Code củ chuối nè, thử xem.Bây giờ từ bài này giả sử em muốn mở rộng bài toán lọc ra những ô bao gồm G, P, E ở một vị trí bất kỳ (không nhất thiết phải liền nhau, miễn theo thứ tự) ví dụ 13GjjPjkjE --> Lọc ra
Xin gửi file đính kèm, nhờ được giúp đỡ (nếu có cả 2 cách VBA và công thức).
Public Sub GPE()
Dim Clls As Range, Tem As Variant, Str As String, I As Long, K As Long
For Each Clls In Range("A1:A100")
Str = ""
For I = 1 To Len(Clls)
If Mid(Clls, I, 1) = "G" Or Mid(Clls, I, 1) = "P" Or Mid(Clls, I, 1) = "E" Then
Str = Str & Mid(Clls, I, 1)
End If
Next I
If Str = "GPE" Then
K = K + 1
Cells(K, 4) = Clls.Value
End If
Next
End Sub
Em muốn nội dung cột A là GPEE thì cũng lọc ra thì phải làm thế nào ah, code của bác nếu ba chữ trên xuất hiện quá 1 lần thì chưa lọc ra. Mong bác tiếp tục hộ cho.
Hihi, thì mình đã nói bài này còn phải sửa nhiều. Làm xong cái này rồi sẽ phát sinh là có phân biệt chữ thường chữ hoa ???? rồi có theo thứ tự G, P, E hay không ????..vân vân..... và vân vân......Em muốn nội dung cột A là GPEE thì cũng lọc ra thì phải làm thế nào ah, code của bác nếu ba chữ trên xuất hiện quá 1 lần thì chưa lọc ra. Mong bác tiếp tục hộ cho.
Nếu dùng code thì quá dễ rồiThưa thày Concogia, em muốn phải ít nhất có 1 cụm G,P,E xuất hiện theo thứ tự lần lượt G-->P-->E : Ví dụ EPG thì không lọc ra, trong Code của thày nó vẫn lọc thì sửa thế nào ah?
(EGPE thì lọc ra vì có ít nhất 1 cụm từ GPE tô màu đỏ thỏa mãn)
Function StrExists(ByVal Str As String, ByVal Patt As String, ByVal MCase As Boolean) As Boolean
Dim tmp As String
On Error Resume Next
tmp = Str
With CreateObject("VBScript.RegExp")
.Global = True
If MCase Then
.Pattern = "[" & Patt & "]"
tmp = .Replace(tmp, "")
Else
.Pattern = "[" & LCase(Patt) & "]"
tmp = .Replace(tmp, "")
.Pattern = "[" & UCase(Patt) & "]"
tmp = .Replace(tmp, "")
End If
.Pattern = "[" & tmp & "]"
tmp = .Replace(Str, "")
StrExists = (InStr(1, tmp, Patt, IIf(MCase, 0, 1)) > 0)
End With
End Function
Sub Main()
Dim sArray, Item, Arr, tmp As String, n As Long
sArray = Range("A1:A1000").Value
On Error Resume Next
Range("I1:I1000").ClearContents
ReDim Arr(1 To UBound(sArray, 1), 1 To 1)
For Each Item In sArray
If CStr(Item) <> "" Then
[B]If StrExists(CStr(Item), "GPE", [COLOR=#ff0000]False[/COLOR]) Then[/B]
n = n + 1
Arr(n, 1) = CStr(Item)
End If
End If
Next
If n Then Range("I1").Resize(n) = Arr
End Sub
Bài này thì đâu cần dùng vòng lặp. Chỉ cần như thế này:Có thể sử dụng hàm kiểm tra sự tồn tại một chuỗi con có xuất hiện (theo thứ tự) trong một chuỗi hay không như sau:
Function SubStr(s As String, d As String) As Boolean
Dim i As Byte, k As Byte, k1 As Byte, kq As Boolean
kq = True
k1 = 1
i = 1
Do
k = InStr(k1, s, Mid(d, i, 1))
kq = kq And (k > 0)
k1 = k + 1
i = i + 1
Loop Until (i > Len(d)) Or (k < 0)
SubStr = kq
End Function
Dùng hàm này làm điều kiện lọc.
Function InString(ByVal Str1 As String, ByVal Str2 As String, ByVal Case_ As Boolean)
Str2 = "*" & Join(Split(StrConv(Str2, 64), Chr(0)), "*")
InString = IIf(Case_, Str1 Like Str2, LCase(Str1) Like LCase(Str2))
End Function
Bài này thì đâu cần dùng vòng lặp. Chỉ cần như thế này:
PHP:Function InString(ByVal Str1 As String, ByVal Str2 As String, ByVal Case_ As Boolean) Str2 = "*" & Join(Split(StrConv(Str2, 64), Chr(0)), "*") InString = IIf(Case_, Str1 Like Str2, LCase(Str1) Like LCase(Str2)) End Function
Có thể sử dụng hàm kiểm tra sự tồn tại một chuỗi con có xuất hiện (theo thứ tự) trong một chuỗi hay không như sau:
.