Mỗi lần làm cái gì liên quan tới CF là tui lại hông xem được thứ gì trong đó. Save as thành *.xls cho tui học với. Huhu.
khi nào có nhiều người khiếu nại không xem được thì mới phải up file khác , 1 mình bạn thì ráng chịu , lêu lêu
Xem được mà cha nội. Đợt trước ông save as thành *xls thì xem được. Đương nhiên là muốn soi thánh soi thật kỹ chứ.
Nói chung vô topic này cũng chém gió nhiều quá, nhậu về buồn ngủ viết cho bạn mấy dòng cho tỉnh
Bạn biết Macro chắc cũng biết xài)
Sub ToMau()
Dim Arr(), I, J, Tem, lr
With Sheet2
.[G6:G10000].Font.Color = vbBlack
lr = Sheet1.Range("B" & Rows.Count).End(3).Row
Arr = Range(.[G6], .[G65000].End(3)).Value
For I = 1 To UBound(Arr)
Tem = Split(Arr(I, 1), " & ")
For J = 0 To UBound(Tem)
If Application.WorksheetFunction.CountIf(Sheet1.Range("B4:B" & lr), Tem(J)) = 0 Then
.Range("G" & I + 5).Characters(InStr(Arr(I, 1), Tem(J)), Len(Tem(J))).Font.Color = vbRed
End If
Next
Next
End With
End SubNói chung vô topic này cũng chém gió nhiều quá, nhậu về buồn ngủ viết cho bạn mấy dòng cho tỉnh
P/s: Bạn chạy thử, sai cứ la lên vì tui cũng chưa có test.Mã:Sub ToMau() Dim Arr(), I, J, Tem, lr With Sheet2 .[G6:G10000].Font.Color = vbBlack lr = Sheet1.Range("B" & Rows.Count).End(3).Row Arr = Range(.[G6], .[G65000].End(3)).Value For I = 1 To UBound(Arr) Tem = Split(Arr(I, 1), " & ") For J = 0 To UBound(Tem) If Application.WorksheetFunction.CountIf(Sheet1.Range("B4:B" & lr), Tem(J)) = 0 Then .Range("G" & I + 5).Characters(InStr(Arr(I, 1), Tem(J)), Len(Tem(J))).Font.Color = vbRed End If Next Next End With End Sub
Cũng đâu có gì đâu bạn. Nguyên một dãy số bên cột B (từ B4 trở xuống) sheet1 là gốc. Sau khi tách từng dòng ở sheet2 theo dấu "&", nếu số nào không có trong cột B sheet1 thì sẽ tô màu.
Nói chung vô topic này cũng chém gió nhiều quá, nhậu về buồn ngủ viết cho bạn mấy dòng cho tỉnh
P/s: Bạn chạy thử, sai cứ la lên vì tui cũng chưa có test.Mã:Sub ToMau() Dim Arr(), I, J, Tem, lr With Sheet2 .[G6:G10000].Font.Color = vbBlack lr = Sheet1.Range("B" & Rows.Count).End(3).Row Arr = Range(.[G6], .[G65000].End(3)).Value For I = 1 To UBound(Arr) Tem = Split(Arr(I, 1), " & ") For J = 0 To UBound(Tem) If Application.WorksheetFunction.CountIf(Sheet1.Range("B4:B" & lr), Tem(J)) = 0 Then .Range("G" & I + 5).Characters(InStr(Arr(I, 1), Tem(J)), Len(Tem(J))).Font.Color = vbRed End If Next Next End With End Sub
Ờ ha. Nhắc mới nhớ, sao chưa thấy anh ấy giải thích nhỉ, nhìn công thức mà hông hiểu gì ráo. Nếu hông phiền xin nhờ tác giả "Chim hồng" hay "ông trùm" giải thích công thức #11 giúp với.P/s: còn anh "Chinh Hồng" sao không trả lời #12 cho bạn í đi...Chạy đâu cho thoát...
[/COLOR]
bạn phải biết là khi ngồi lên con Cam Rỳ thì sao còn muốn cưỡi Giấc mơ Trung Hoa nữa ? đã có siêu cao thủ làm ra được bảng 3 rồi thì tôi biết thân biết phận xếp xó ngồi im thôi chứ trả lời gì nữaXác nhận lại ý trên: Chính xác là phải liên lạc lại với anh ấy...nhé!
P/s: còn anh "Chinh Hồng" sao không trả lời #12 cho bạn í đi...
[/COLOR]
Nhiều sheet thì cần chỉnh lại code. Nhưng mà có điều sao bạn không nói từ đầu, với lại có cấu trúc như sheet2, tức là bảng 3 cũng nằm y chang như vậy hả. (Nếu khác thì gửi lại file 1 lần nữa, code luôn 1 lần, chứ ngại viết nữa rồi sửa nữa lắm.)
"Chàng" đừng có nói thế. "Chàng" mà viết code thì cái code trên của "thiếp" bỏ sọt sớm thôi.
Thế bạn thử lại với cái này xem sao:
Sub ToMau()
Dim Arr(), Ws, I, J, Tem, lr
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sheet1" Then
With Ws
.[G6:G10000].Font.Color = vbBlack
lr = Sheet1.Range("B" & Rows.Count).End(3).Row
Arr = .Range(.[G6], .[G65000].End(3)).Value
For I = 1 To UBound(Arr)
Tem = Split(Arr(I, 1), " & ")
For J = 0 To UBound(Tem)
If Application.WorksheetFunction.CountIf(Sheet1.Range("B4:B" & lr), Tem(J)) = 0 Then
.Range("G" & I + 5).Characters(InStr(Arr(I, 1), Tem(J)), Len(Tem(J))).Font.Color = vbRed
End If
Next
Next
End With
End If
Next Ws
End SubQuả thực là rất nhanh ,, xin cảm ơn bạn rất nhiều.
Cứ nói quá hông à. Sợ "chàng" soi nên nói trước ấy chứ, sợ lắm 2 từ "trách nhiệm".
Thử thêm cái mớ hỗn độn này vậy:
Sub ToMau()
Dim Arr(), Ws, I, J, Tem, lr, lrs
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sheet1" Then
With Ws
.[G6:G10000].Font.Color = vbBlack
lr = Sheet1.Range("B" & Rows.Count).End(3).Row
lrs = .Range("G" & Rows.Count).End(3).Row
If lrs = 6 Then
Arr = .[G6:G7].Value
Else
Arr = .Range(.[G6], .[G65000].End(3)).Value
End If
For I = 1 To UBound(Arr)
If Arr(I, 1) <> Empty Then
Tem = Split(Arr(I, 1), " & ")
For J = 0 To UBound(Tem)
If Application.WorksheetFunction.CountIf(Sheet1.Range("B4:B" & lr), Tem(J)) = 0 Then
.Range("G" & I + 5).Characters(InStr(Arr(I, 1), Tem(J)), Len(Tem(J))).Font.Color = vbRed
End If
Next
End If
Next
End With
End If
Next Ws
End SubVì khi chạy code I bắt đầu bằng 1, mà cột G của bạn bắt đầu từ dòng 6 nên + thêm 5.
Lâu lâu hứng lên viết mà mấy anh cứ bắt bí tui quá. Mốt tui nhậu say là về ngủ luôn.Ơ nói vậy là không giải quyết ah...tính cho qua ah???. Giải quyết triệt để cái vụ "Chim Hồng" đã gợi ý ở trên đi chứ.... "Chủ trương là phải Triệt Để" nhé!
Gọn hơn nhưng hiệu quả thì phải coi lại nha "cưng". Vụ này hồi nhớ có chọc ông 1 lần rồi. Bữa nay mình lại bị phá lại. >"<
Gọn hơn nhưng hiệu quả thì phải coi lại nha "cưng". Vụ này hồi nhớ có chọc ông 1 lần rồi. Bữa nay mình lại bị phá lại. >"<
P/s: Cơ mà hãy thử cái dòng đó vô code trên xem.
cái trường đó thiệt là vô trách nhiệm với xã hội quá đi à
Tui và ảnh ấy chung trường, chung thầy cô dạy, cho nên không thể nào đổ lỗi do nhà trường hay thầy cô được
Cụ thể là bạn muốn 1 code mới để riêng cho trường hợp này? Code đó tô 1 lúc 2 bảng luôn. Hay bảng 1 là bạn để làm công thức?
Đúng vậy bạn ah đây là một bài toán mới.
=IF(ISNUMBER(FIND("&",$E6)), SUMPRODUCT(--(1* MID(SUBSTITUTE($E6,"&",REPT(" ",99)),(ROW(OFFSET($A$1,,,LEN($E6)-LEN(SUBSTITUTE($E6,"&",""))))-1)*99+1,99) < 1* MID(SUBSTITUTE($E6,"&",REPT(" ",99)),(ROW(OFFSET($A$1,,,LEN($E6)-LEN(SUBSTITUTE($E6,"&","")))))*99,99)))<LEN($E6)-LEN(SUBSTITUTE($E6,"&","")))Xin cảm ơn bạn đã giúp đỡ tôi
nó không cho đi cửa trước thì chui cửa sau , chép công thức vào cột kế bên , trong ô CF gọi đến ô đó
Giới hạn của file Excel 2003 là 255 ký tự, Excel 2007 là 8192.Theo suy đoán chủ quan của tôi thì cái ô CF trong excel nó giới hạn về độ dài (ký tự) trong công thức. Nhưng không rõ là nó giới bạn bao nhiêu... Cho nên nếu công thức quá dài thì không có cách nào mà ép nó vào được...
Được chứ sao lại không. Tuy nhiên, sau khi save as bạn phải đóng và mở lại file thì mới được. Bạn xem file đính kèm.
Sau khi đánh dấu bằng màu bạn sẽ làm gì tiếp theo? Nếu bạn đánh dấu để sửa lại cho đúng chuẩn thì sao không nhờ mọi người giúp chuyển dữ liệu về đúng chuẩn luôn mà phải đi đường vòng???
Chỉnh lại để bạn xài theo kiểu mới:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 7 Then
Dim Arr(), I, J, Tem, lr, Num
With Sheet1
.[G6:G10000].Font.Color = vbBlack
lr = .Range("G" & Rows.Count).End(3).Row
If lr = 6 Then
Arr = .[G6:G7].Value
Else
Arr = .Range(.[G6], .[G65000].End(3)).Value
End If
For I = 1 To UBound(Arr)
Num = 0
If Arr(I, 1) <> Empty Then
Tem = Split(Arr(I, 1), " & ")
End If
For J = 1 To UBound(Tem)
If Val(Tem(J)) < Val(Tem(J - 1)) Then
Num = Num + Len(Tem(J - 1)) + 3 * J
.Range("G" & I + 5).Characters(InStr(Num, Arr(I, 1), Tem(J)), Len(Tem(J))).Font.Color = vbRed
End If
Next
Next
End With
End If
End SubTặng bạn UDF này. Có thể sắp xếp chuỗi/số, tăng/giảm
Function SortText(ByVal Text As String, Optional ByVal Delimiter As String, Optional ByVal ZtoA As Boolean = False, Optional ByVal IsNum As Boolean = False) As String
Dim Arr As Variant, Arr1 As Variant, i As Long
Arr = Split(Text, Delimiter)
If IsNum Then
ReDim Arr1(LBound(Arr, 1) To UBound(Arr, 1))
For i = LBound(Arr, 1) To UBound(Arr, 1)
Arr1(i) = Val(Arr(i))
Next
Else
Arr1 = Arr
End If
SortArr Arr1, ZtoA
SortText = Join(Arr1, Delimiter)
End FunctionPrivate Sub SortArr(ByRef Arr1, ByVal ZtoA)
Dim i As Long, j As Long, TmpVal
For i = LBound(Arr1, 1) To UBound(Arr1, 1) - 1
For j = i + 1 To UBound(Arr1, 1)
If (Arr1(i) < Arr1(j)) = ZtoA Then
TmpVal = Arr1(i): Arr1(i) = Arr1(j): Arr1(j) = TmpVal
End If
Next
Next
End Sub
