Duyệt qua nhiều sheet có cấu trúc khác nhau, nếu ô nào trống hoặc không đúng theo điều kiện thì thông báo lỗi

[LienDong]

Em chào các anh /chị
Hôm qua em có nhờ các anh chị

Duyệt các file trong folder, xem tất cả các sheet trong file để xem có ô nào trống thì thông báo

Em nhờ các anh/chị giúp em như sau: Em có 1 floder bất kỳ Trong đó có nhiều file (tên file có thể có dấu tiếng Việt) Trong 1 File có nhiều sheet Bây giờ tìm trong các sheet đó xem có ô nào trống không? Em ví dụ: file gởi lên thì ở sheet Lop1.1 có ô C8 là bị trống Yêu cầu của em: Sau khi chạy...

www.giaiphapexcel.com

Và vấn đề trên đã được giải quyết
Và em muốn dựa vào các code của chủ đề trên để viết cho bài toán sau:
1/ Trong 1 floder sẽ có nhiều file, các file này sẽ có số lượng sheet và tên sheet giống nhau, Chỉ khác nhau ở số lượng dòng
Ở file đính kèm của em có 3 sheet:
a/ Ở sheet NX1:
- Dùng cột B để xác định dòng cuối
- Nếu ô nào của cột E, F bị trống hay không phải ký tự "Y" hay "N" thì thông báo bằng Msg
b/ Ở sheet NX2:
- Tương tự Dùng cột B để xác định dòng cuối
- Nếu ô nào của cột D, E bị trống hay không phải ký tự "Y" hay "N" thì thông báo bằng Msg
c/ Ở sheet NX3:
- Tương tự Dùng cột B để xác định dòng cuối
- Nếu ô nào của cột C bị trống hay không phải ký tự "Y" hay "N" thì thông báo bằng Msg

2/ Yêu cầu của em xác định các file trong floder để chạy code thì đã được giải quyết
3/ Bây giờ chỉ còn yêu cầu như mô tả của phần 1 là chưa được giải quyết
Em có dựa vào code của các anh/chị để viết tạm cho sheet NX1 nhưng nó thông báo vẫn không đúng như yêu cầu (trong sheet NX1, cột E, F chỉ có vài ô bị lỗi, nhưng nó báo toàn bộ các ô bị lỗi) . Vậy mong các anh/chị sửa hay hướng dẫn giúp, code của em viết

Sub CellTrong_LoiTheoCot()
Dim ws As Worksheet, cll As Range, i As Long
With Sheets("NX1")
i = .Range("B" & Rows.Count).End(xlUp).Row
For Each cll In Range("E2:F" & i)
If cll.Value = "" Or cll.Value <> "Y" Or cll.Value <> "N" Then
MsgBox "Ô: " & cll.Address
End If
Next
End With
End Sub

P/s: Code em sẽ để ở file khác để chạy code cho các file muốn kiểm tra
Em cảm ơn anh/chị

 

[LienDong]

Thêm bẩy lỗi

Sub Main()
  Dim wB As Workbook, ListFile As Object, FileItem, wbMain As Workbook
  Dim wSh As Worksheet, cll As Range
  Dim aShName, aCol, S, tmp
  Dim eRow&, i&, n&, j&, fCol&, eCol&, NameSh$, NameFile$

  aShName = Array("NX1", "NX2", "NX3")
  aCol = Array("5-6", "4-5", "3")
  Set wbMain = ThisWorkbook
  Set ListFile = GetFile("")
  If ListFile Is Nothing Then MsgBox "Chua chon File, thoat Sub ": Exit Sub
  For Each FileItem In ListFile
    If InStr(1, FileItem, "\" & wbMain.Name, vbTextCompare) = 0 Then
      On Error Resume Next
      S = Split(FileItem, "\")
      NameFile = S(UBound(S))
      Set wB = Application.Workbooks.Item(NameFile)
      If Err.Number > 0 Then Set wB = Workbooks.Open(FileItem)
      For Each wSh In wB.Sheets
        NameSh = wSh.Name
        For n = LBound(aShName) To UBound(aShName)
          If NameSh = aShName(n) Then
            eRow = wSh.Range("B" & Rows.Count).End(xlUp).Row
            If eRow > 1 Then
              S = Split("-" & aCol(n), "-")
              fCol = CLng(S(1)): eCol = CLng(S(UBound(S)))
              For i = 2 To eRow
                For j = fCol To eCol
                  tmp = wSh.Cells(i, j).Value
                  If Not (tmp = "Y" Or tmp = "N") Then
                    MsgBox "File " & NameFile & ", Sheet " & NameSh & ", Ô " & wSh.Cells(i, j).Address
                  End If
                Next j
              Next i
            End If
            Exit For
          End If
        Next n
      Next wSh
      If Err.Number > 0 Then wB.Close False
      On Error GoTo 0
    End If
  Next FileItem
  Set ListFile = Nothing: Set FileItem = Nothing
End Sub

Function GetFile(ByVal strPath As String) As Variant
  Dim Fldr As FileDialog, sItem As Variant
  Set Fldr = Application.FileDialog(msoFileDialogFilePicker)
  With Fldr
    .AllowMultiSelect = True
    .InitialFileName = strPath
    .Filters.Add "Images", "*.xls*"
    If .Show = -1 Then Set GetFile = .SelectedItems Else Set GetFile = Nothing
  End With
  Set Fldr = Nothing
End Function

Em cảm ơn các anh/chị nhiều