Bỏ cột phụ trong file dùng để tìm và tô màu chử (1 người xem)

[mymichau]

Em có áp dụng phương thức FindMethod của Thầy Long để tìm và tô màu chử khi gặp. Nhưng cảm thấy khó chịu về 2 cột phụ. Vậy làm sao bỏ được 2 cột phụ như trong file ví dụ. Xin cảm ơn

 

[hoangdanh282vn]

Em có áp dụng phương thức FindMethod của Thầy Long để tìm và tô màu chử khi gặp. Nhưng cảm thấy khó chịu về 2 cột phụ. Vậy làm sao bỏ được 2 cột phụ như trong file ví dụ. Xin cảm ơn

Bạn thêm đoạn Code màu đỏ ở cuối Sub vào nữa là được.

Option Explicit
Sub MyFind1() 'Pham Duy Long. Good
Dim r As Long, rW As Long, rF1 As Long, rF2 As Long, S As Long
Dim sFind
On Error Resume Next
Columns("B").ClearContents
Columns("C").ClearContents
Range("B1").FormulaR1C1 = "=LEN(RC[-1])"
r = 1
sFind = " " & Range("A1").Value & ""
rF1 = Columns("A").Find(What:=sFind).Row
If rF1 = 0 Then Exit Sub
rF2 = rF1
Do
r = rF2
Cells(r, 2) = "=Tomau"
Cells(r, 3) = "=Tomau1"
'To mau chu khi gap lan thu 1
With Cells(r, 1).Characters(Start:=Cells(r, 2).Value, Length:=Range("B1").Value).Font
.ColorIndex = 3
.Bold = True
End With
'To mau chu khi gap lan thu 1
With Cells(r, 1).Characters(Start:=Cells(r, 3).Value, Length:=Range("B1").Value).Font
.ColorIndex = 3
.Bold = True
End With
rF2 = Columns("A").Find(What:=sFind, After:=Cells(rF2, 1)).Row
If rF2 <= rF1 Then Exit Do
Loop
'Them AutoFilter
Range("A2:C40").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="<>"
[B:C].Clear
End Sub

 

[ThuNghi]

Em có áp dụng phương thức FindMethod của Thầy Long để tìm và tô màu chử khi gặp. Nhưng cảm thấy khó chịu về 2 cột phụ. Vậy làm sao bỏ được 2 cột phụ như trong file ví dụ. Xin cảm ơn

Dùng code sau có vẻ pro hơn, đang tìm cách để Instr chọn 1 chữ, ví dụ: "Mon" và "monday"

Option Explicit
Sub MyFind()
Dim MyRng As Range, RngFound As Range, i As Long, j As Long, iStar As Long
Dim eR As Long, iFind As String, Dem As Long, iLen As Long, iL As Long, k As Long
Sheet1.Select
eR = [A65000].End(xlUp).Row
Set MyRng = Range("A2:A" & eR)
iFind = Trim(Range("A1").Value)
iLen = Len(iFind)
Dem = WorksheetFunction.CountIf(MyRng, "*" & iFind & "*")
Set RngFound = MyRng(1)
For i = 1 To Dem
    With MyRng
        Set RngFound = .Find("*" & iFind & "*", After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
    End With
    iL = (Len(RngFound) - Len(Replace(RngFound, iFind, "", 1, -1, vbDatabaseCompare))) / iLen 
    For j = 1 To Len(RngFound)
            If k = iL Then Exit For
            iStar = InStr(j, RngFound & " ", iFind & " ", 1)
                With RngFound.Characters(Start:=iStar, Length:=iLen).Font
                     .ColorIndex = 3
                    .Bold = True
                End With
                k = k + 1
          Next
          k = 0
Next
'Them AutoFilter
    Range("A2:A" & eR).Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="=*" & iFind & "*", Operator:=xlAnd
End Sub

To Danh:
1/ Có 1 điều hay mà Lệnh Hồ Đại hiệp đã chỉ ra là, nếu trước đó ta đã
setRngFound= .Find("*" & iFind & "*", After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
Đại loại là như vậy thì khi ta dùng lệnh sau
rF1 = Columns("A").Find(What:=sFind).Row
Nó sẽ không chạy, do nó đang mặc định file trước. =>nên set đầy đủ tham số.
2/ Code của Danh sẽ không phân biệt được "Mon", "mon", "MON" và nếu thêm 1 chữ Mon nữa thì nó sẽ không tô màu, bold. Chỉ làm có 2 lần.

 

[mymichau]

To: HoangDanh282vn. Xóa trước hay sau vẫn phải dùng 2 cột phụ để thực hiện việc tô màu chử.
Cảm ơn Anh ThuNghi nhiều. Anh có thể sữa giúp tiếp tô màu tất cả chử mon trong một cell được không ( hiện chỉ tô được 2 chử ).

 

[ThuNghi]

To: HoangDanh282vn. Xóa trước hay sau vẫn phải dùng 2 cột phụ để thực hiện việc tô màu chử.
Cảm ơn Anh ThuNghi nhiều. Anh có thể sữa giúp tiếp tô màu tất cả chử mon trong một cell được không ( hiện chỉ tô được 2 chử ).

Có phải file này yêu cầu tô theo chữ ở A1, tôi thấy tô bao nhiêu chữ cũng OK mà.
Xem file thử, sẽ edit lại code về phần tìm UCase sau.

 

[mymichau]

To: Anh ThuNghi
File anh gởi kèm chỉ tô màu được 2 chữ mon trong một cell.