Tìm và thông báo các ô không thỏa điều kiện

hoanglocphat · 19/7/20

Chào các bạn GPE
Tôi muốn tìm trong các cột F, G, H và từ dòng thứ 7 xuống
Nếu các ô nào có tô màu mà không có số liệu hay không phải là số (number) thì thông báo
Nếu ô nào không có tô màu mà có số liệu thì cũng thông báo
Như ví dụ trong file thì các ô F11, F15, F16, G10, H11, H16 sẽ bị thông báo
Cảm ơn các bạn!

hoanglocphat · 20/7/20

Các bạn cho tôi hỏi, bài trên có thể viết được không ạ!

xuongrongdat · 20/7/20

hoanglocphat đã viết:
Các bạn cho tôi hỏi, bài trên có thể viết được không ạ!

Bài của bạn khó ghê, mình không biết làm! Mà chắc anh chị chú bác trên đây có nhiều người viết được á.
Mà bạn cho mình hỏi cái, bạn muốn thông báo hình thức ra sao?

hoanglocphat · 20/7/20

xuongrongdat đã viết:
Mà bạn cho mình hỏi cái, bạn muốn thông báo hình thức ra sao?

Thông báo bằng Msgbox đó bạn (nếu có thể thì gom tất cả thông báo 1 lần)

xuongrongdat · 20/7/20

hoanglocphat đã viết:
Thông báo bằng Msgbox đó bạn (nếu có thể thì gom tất cả thông báo 1 lần)

Quá khó đối với cá nhân mình, hi.
Mình chỉ có thể tự suy nghĩ được tới đoạn gom điều kiện chung lại cho những ô thông báo, đó là: rỗng hoặc text hoặc không màu, hi.
Bạn chờ các cao nhân vào nhé !

Nhattanktnn · 20/7/20

hoanglocphat đã viết:
Chào các bạn GPE
Tôi muốn tìm trong các cột F, G, H và từ dòng thứ 7 xuống
Nếu các ô nào có tô màu mà không có số liệu hay không phải là số (number) thì thông báo
Nếu ô nào không có tô màu mà có số liệu thì cũng thông báo
Như ví dụ trong file thì các ô F11, F15, F16, G10, H11, H16 sẽ bị thông báo
Cảm ơn các bạn!

Mình vẫn không hiểu ý "thông báo" của bạn đây là gì? Nếu là thông báo theo kiểu liệt kê ra các ô vào msgbox mà với dữ liệu lớn thì msgbox sao chịu nổi? Mình nghĩ xuất dữ liệu những ô nào có vấn đề đó ra sheets mới thì hợp lý hơn

Nhattanktnn · 20/7/20

Xem như này có được không

hoanglocphat · 20/7/20

Nhattanktnn đã viết:
Mình vẫn không hiểu ý "thông báo" của bạn đây là gì? Nếu là thông báo theo kiểu liệt kê ra các ô vào msgbox mà với dữ liệu lớn thì msgbox sao chịu nổi? Mình nghĩ xuất dữ liệu những ô nào có vấn đề đó ra sheets mới thì hợp lý hơn

Ở đây tui kiểm tra phải nhập số liệu (number) vào những ô tô màu và không được nhập số liệu ở những ô không tô màu -> vấn đề này sẽ xảy ra không nhiều nên vẫn có thể gom vào 1 thông báo, hoặc có thể thông báo cho từng trường xảy ra rồi tiếp tục thông báo cho các trường hợp khác. Do phải kiểm tra thường xuyên nên mới dùng đến code
Thường tôi dùng Filter by color xong đến filter ->Blanks để kiểm tra
Hoặc không thông báo mà liệt kê vào cột I (từ I7 xuống)
Cảm ơn trước các bạn!

Bluestar092011 · 20/7/20

hoanglocphat đã viết:
Chào các bạn GPE
Tôi muốn tìm trong các cột F, G, H và từ dòng thứ 7 xuống
Nếu các ô nào có tô màu mà không có số liệu hay không phải là số (number) thì thông báo
Nếu ô nào không có tô màu mà có số liệu thì cũng thông báo
Như ví dụ trong file thì các ô F11, F15, F16, G10, H11, H16 sẽ bị thông báo
Cảm ơn các bạn!

Dùng tạm Code này xem sao.

Mã:

Sub GPE()
    Dim Rng As Range, MesRng As Range, sCell As Range
    Set Rng = Sheet1.Range("F6").CurrentRegion.Offset(1)

    For Each sCell In Rng
        If (sCell.Interior.Pattern = xlNone And sCell <> Empty) Or (sCell.Interior.Pattern <> xlNone And (sCell = Empty Or Not IsNumeric(sCell))) Then
            If MesRng Is Nothing Then
                Set MesRng = sCell
            Else
                Set MesRng = Union(MesRng, sCell)
            End If
        End If
    Next sCell
    If Not MesRng Is Nothing Then MsgBox MesRng.Address
End Sub

Ba Tê · 20/7/20

hoanglocphat đã viết:
Ở đây tui kiểm tra phải nhập số liệu (number) vào những ô tô màu và không được nhập số liệu ở những ô không tô màu -> vấn đề này sẽ xảy ra không nhiều nên vẫn có thể gom vào 1 thông báo, hoặc có thể thông báo cho từng trường xảy ra rồi tiếp tục thông báo cho các trường hợp khác. Do phải kiểm tra thường xuyên nên mới dùng đến code
Thường tôi dùng Filter by color xong đến filter ->Blanks để kiểm tra
Hoặc không thông báo mà liệt kê vào cột I (từ I7 xuống)
Cảm ơn trước các bạn!

Thử code này:

PHP:

Public Sub s_Gpe()
Dim Rng As Range, Cll As Range, Txt As String
Set Rng = Range("F7:H16") 'Vung du lieu can xet'
For Each Cll In Rng
    If Cll.Interior.Pattern = xlNone Then
        If Len(Cll.Value) Then
            Txt = Txt & IIf(Len(Txt), "-", "") & Cll.Address
        End If
    Else
        If Cll.Value = Empty Or Not IsNumeric(Cll.Value) Then
            Txt = Txt & IIf(Len(Txt), "-", "") & Cll.Address
        End If
    End If
Next Cll
Range("I2") = IIf(Len(Txt), Replace(Txt, "$", ""), "Khong co gi")
End Sub

hoanglocphat · 20/7/20

Ba Tê đã viết:

Thử code này:

PHP:

Public Sub s_Gpe()
Dim Rng As Range, Cll As Range, Txt As String
Set Rng = Range("F7:H16") 'Vung du lieu can xet'
For Each Cll In Rng
    If Cll.Interior.Pattern = xlNone Then
        If Len(Cll.Value) Then
            Txt = Txt & IIf(Len(Txt), "-", "") & Cll.Address
        End If
    Else
        If Cll.Value = Empty Or Not IsNumeric(Cll.Value) Then
            Txt = Txt & IIf(Len(Txt), "-", "") & Cll.Address
        End If
    End If
Next Cll
Range("I2") = IIf(Len(Txt), Replace(Txt, "$", ""), "Khong co gi")
End Sub

Em cảm ơn anh Ba Tê
Em quên nói là các ô trong file của em được tô màu bởi Conditional Formatting
Code trên em đoán là sửa chỗ: If Cll.Interior.Pattern = xlNone Then
Không biết có đúng không và sửa như thế nào?
Mong anh Ba Tê hoặc các bạn nào biết thì sửa code giúp
Em cảm ơn ạ!

giaiphap · 20/7/20

hoanglocphat đã viết:
Em cảm ơn anh Ba Tê
Em quên nói là các ô trong file của em được tô màu bởi Conditional Formatting
Code trên em đoán là sửa chỗ: If Cll.Interior.Pattern = xlNone Then
Không biết có đúng không và sửa như thế nào?
Mong anh Ba Tê hoặc các bạn nào biết thì sửa code giúp
Em cảm ơn ạ!

Gợi ý thế này.

Mã:

   Cll.DisplayFormat.Interior.Color

hoanglocphat · 21/7/20

giaiphap đã viết:
Gợi ý thế này.

Mã:

Cll.DisplayFormat.Interior.Color

Cảm ơn bạn để tôi nghỉ cách thêm

hoanglocphat · 22/7/20

giaiphap đã viết:
Gợi ý thế này.

Mã:

Cll.DisplayFormat.Interior.Color

Tôi đã sửa code ở trên thành
If Cll.DisplayFormat.Interior.Color then
Hoặc thành
If Cll.DisplayFormat.Interior.Color = xlNone Then
thì code vẫn chưa cho kết quả đúng
Nhờ bạn hướng dẫn thêm. Cảm ơn bạn

HieuCD · 22/7/20

hoanglocphat đã viết:
Tôi đã sửa code ở trên thành
If Cll.DisplayFormat.Interior.Color then
Hoặc thành
If Cll.DisplayFormat.Interior.Color = xlNone Then
thì code vẫn chưa cho kết quả đúng
Nhờ bạn hướng dẫn thêm. Cảm ơn bạn

Code chạy theo định dạng điều kiện

Mã:

Sub ABC()
  Dim Rng As Range, iCell As Range, aDK
  Dim fRow&, eRow&, i&, fCol&, eCol&, j&, Res As String
  
  aDK = Array("", 1, 2, 3) 'Dieu kien dinh dang
  Set Rng = Range("F7:H16") 'Vung du lieu can xet
  fRow = Rng.Row:     eRow = fRow + Rng.Rows.Count - 1
  fCol = Rng.Column:  eCol = fCol + Rng.Columns.Count - 1
  For i = fRow To eRow
    For j = fCol To eCol
      Set iCell = Cells(i, j)
      If Not (((iCell <> Empty) = IsNumeric(iCell)) = (Cells(i, j - 4) = aDK(j - 5))) Then
        Res = Res & "-" & iCell.Address(0, 0)
      End If
    Next j
  Next i
  If Len(Res) Then MsgBox ("Cac O Khong Dung: " & Mid(Res, 2, Len(Res)))
End Sub

hoanglocphat · 23/7/20

HieuCD đã viết:

Code chạy theo định dạng điều kiện

Mã:

Sub ABC()
  Dim Rng As Range, iCell As Range, aDK
  Dim fRow&, eRow&, i&, fCol&, eCol&, j&, Res As String
 
  aDK = Array("", 1, 2, 3) 'Dieu kien dinh dang
  Set Rng = Range("F7:H16") 'Vung du lieu can xet
  fRow = Rng.Row:     eRow = fRow + Rng.Rows.Count - 1
  fCol = Rng.Column:  eCol = fCol + Rng.Columns.Count - 1
  For i = fRow To eRow
    For j = fCol To eCol
      Set iCell = Cells(i, j)
      If Not (((iCell <> Empty) = IsNumeric(iCell)) = (Cells(i, j - 4) = aDK(j - 5))) Then
        Res = Res & "-" & iCell.Address(0, 0)
      End If
    Next j
  Next i
  If Len(Res) Then MsgBox ("Cac O Khong Dung: " & Mid(Res, 2, Len(Res)))
End Sub

Chào bạn!
Thực tế thì điều kiện CF để tôi đặt là không cố định
Tôi dùng điều kiện là: nếu tìm chữ a thì tôi dùng =SEARCH("a";B7&B7) (công thức này tôi tìm được trong diễn đàn, với mục đích tìm theo nhiều điều kiện)
Vì thế với code trên của bạn thì tôi tùy biến, tôi đặt điều kiện ở ô F5 là a
Tuy nhiên sau khi sửa thì nó thông báo không đúng, mong bạn sửa giúp

PHP:

Sub xyz_2()
  Dim Rng As Range, iCell As Range, aDK
  Dim fRow&, eRow&, i&, fCol&, eCol&, j&, Res As String
  
  aDK = Array("", "a") 'Dieu kien dinh dang
  Set Rng = Range("F7:F16") 'Vung du lieu can xet
  fRow = Rng.Row:     eRow = fRow + Rng.Rows.Count - 1
  fCol = Rng.Column:  eCol = fCol + Rng.Columns.Count - 1
  For i = fRow To eRow
    For j = fCol To eCol
      Set iCell = Cells(i, j)
      
      'If Not (((iCell <> Empty) = IsNumeric(iCell)) = (Cells(5, j - 4) = aDK(j - 5))) Then
      If Not (((iCell <> Empty) = IsNumeric(iCell)) = (Cells(5, 6).Value = aDK(j - 5))) Then
   
             Res = Res & "-" & iCell.Address(0, 0)
      End If
    Next j
  Next i
  If Len(Res) Then MsgBox ("Cac O Khong Dung: " & Mid(Res, 2, Len(Res)))
End Sub

Mong bạn giúp vì đã làm phiền bạn. xin cảm ơn!

HieuCD · 23/7/20

hoanglocphat đã viết:
Chào bạn!
Thực tế thì điều kiện CF để tôi đặt là không cố định
Tôi dùng điều kiện là: nếu tìm chữ a thì tôi dùng =SEARCH("a";B7&B7) (công thức này tôi tìm được trong diễn đàn, với mục đích tìm theo nhiều điều kiện)
Vì thế với code trên của bạn thì tôi tùy biến, tôi đặt điều kiện ở ô F5 là a
Tuy nhiên sau khi sửa thì nó thông báo không đúng, mong bạn sửa giúp

PHP:

Sub xyz_2() Dim Rng As Range, iCell As Range, aDK Dim fRow&, eRow&, i&, fCol&, eCol&, j&, Res As String aDK = Array("", "a") 'Dieu kien dinh dang Set Rng = Range("F7:F16") 'Vung du lieu can xet fRow = Rng.Row: eRow = fRow + Rng.Rows.Count - 1 fCol = Rng.Column: eCol = fCol + Rng.Columns.Count - 1 For i = fRow To eRow For j = fCol To eCol Set iCell = Cells(i, j) 'If Not (((iCell <> Empty) = IsNumeric(iCell)) = (Cells(5, j - 4) = aDK(j - 5))) Then If Not (((iCell <> Empty) = IsNumeric(iCell)) = (Cells(5, 6).Value = aDK(j - 5))) Then Res = Res & "-" & iCell.Address(0, 0) End If Next j Next i If Len(Res) Then MsgBox ("Cac O Khong Dung: " & Mid(Res, 2, Len(Res))) End Sub

Mong bạn giúp vì đã làm phiền bạn. xin cảm ơn!

Chạy code

Mã:

Option Compare Text

Sub xyz_2()
  Dim Rng As Range, iCell As Range, aDK
  Dim fRow&, eRow&, i&, fCol&, eCol&, j&, Res As String
 
  aDK = Array("", "a") 'Dieu kien dinh dang
  Set Rng = Range("F7:F16") 'Vung du lieu can xet
  fRow = Rng.Row:     eRow = fRow + Rng.Rows.Count - 1
  fCol = Rng.Column:  eCol = fCol + Rng.Columns.Count - 1
  For i = fRow To eRow
    For j = fCol To eCol
      Set iCell = Cells(i, j)
      If Not (((iCell <> Empty) = IsNumeric(iCell)) = (Cells(i, j - 4) Like "*" & aDK(j - 5) & "*")) Then
        Res = Res & "-" & iCell.Address(0, 0)
      End If
    Next j
  Next i
  If Len(Res) Then MsgBox ("Cac O Khong Dung: " & Mid(Res, 2, Len(Res)))
End Sub

Tìm và thông báo các ô không thỏa điều kiện

Thành viên thường trực

File đính kèm

Thành viên thường trực

Có bao giờ bạn tự hỏi "Tôi là ai?"

Thành viên thường trực

Có bao giờ bạn tự hỏi "Tôi là ai?"

Thành viên gắn bó

Thành viên gắn bó

File đính kèm

Thành viên thường trực

Thành viên hoạt động

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên thường trực

==(^o^)==

Thành viên thường trực

Thành viên thường trực

File đính kèm

Chuyên gia GPE

Thành viên thường trực

File đính kèm

Chuyên gia GPE