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 · 29/8/20

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ị

BuiQuangThuan · 29/8/20

Sao bạn không đem tất cả các yêu cầu gom lại hỏi 1 thể nhỉ.

LienDong · 29/8/20

buiquangthuan đã viết:
Sao bạn không đem tất cả các yêu cầu gom lại hỏi 1 thể nhỉ.

À tại vì nghĩ đơn giản là tự mình áp dụng vô nhưng cuối cùng vẫn không là được
Bạn giúp giùm sửa code trên được không ạ

Maika8008 · 29/8/20

LienDong đã viết:
À tại vì nghĩ đơn giản là tự mình áp dụng vô nhưng cuối cùng vẫn không là được
Bạn giúp giùm sửa code trên được không ạ

Tôi thích kiểu người ưa vọc vạch như bạn, nhưng đã thế rồi thì cố tí nữa đi!

LienDong · 29/8/20

Maika8008 đã viết:
Tôi thích kiểu người ưa vọc vạch như bạn, nhưng đã thế rồi thì cố tí nữa đi!

Vọc từ sáng đến giờ mà vẫn chưa được
Em đoán là có thể bị sai câu lệnh nào trong "With" ... "End With" nhưng vẫn không tìm ra ạ

Maika8008 · 29/8/20

LienDong đã viết:
Vọc từ sáng đến giờ mà vẫn chưa được
Em đoán là có thể bị sai câu lệnh nào trong "With" ... "End With" nhưng vẫn không tìm ra ạ

Cứ F9 với F8 là biết lệnh sai chỗ nào. Biết rồi thì trị được hà.

BuiQuangThuan · 29/8/20

Hihi. Tắt máy tính tan ca rồi. Không thì cũng thử xem nó ra sao. Chắc chờ mấy anh chị trên này coi vây

LienDong · 29/8/20

Maika8008 đã viết:
Cứ F9 với F8 là biết lệnh sai chỗ nào. Biết rồi thì trị được hà.

bạn cho hỏi cách dùng F9, F8 để kiểm tra lỗi như thế nào?

BuiQuangThuan · 29/8/20

Mã:

Sub CellTrong_LoiTheoCot()
Dim ws As Worksheet, cll As Range, i As Long, ws as worksheet
For each ws in worksheets
i =ws .Range("B" & Rows.Count).End(xlUp).Row
If ws.name = "NX1" then
With ws
For Each cll In ws.Range("E2:F" & i)
If cll.Value = "" Or cll.Value <> "Y" Or cll.Value <> "N" Then
MsgBox "Ô: " & cll.Address
Elseif ws.name= "NX2" then
' làm gì gì đó.......
Else
' làm gì gì đó
End If
Next
End With
Next
End Sub

Bạn thử logic theo cái này coi. Xin lỗi. Do mình viết trên điện thoại. Không biết nó đúng sai thế nào

LienDong · 29/8/20

buiquangthuan đã viết:
Mã:

Sub CellTrong_LoiTheoCot() Dim ws As Worksheet, cll As Range, i As Long, ws as worksheet For each ws in worksheets i =ws .Range("B" & Rows.Count).End(xlUp).Row If ws.name = "NX1" then With ws For Each cll In ws.Range("E2:F" & i) If cll.Value = "" Or cll.Value <> "Y" Or cll.Value <> "N" Then MsgBox "Ô: " & cll.Address Elseif ws.name= "NX2" then ' làm gì gì đó....... Else ' làm gì gì đó End If Next End With Next End Sub

Bạn thử logic theo cái này coi. Xin lỗi. Do mình viết trên điện thoại. Không biết nó đúng sai thế nào

Nó báo lỗi ở dòng (khi copy vào module đã hiện chữ đỏ)
i =ws .Range("B" & Rows.Count).End(xlUp).Row
em đã xóa bớt ", ws As Worksheet"
nhưng nó vẫn báo lỗi dòng trên với lỗi " Syntax error"
Nhờ anh nhé

BuiQuangThuan · 29/8/20

LienDong đã viết:
Nó báo lỗi ở dòng (khi copy vào module đã hiện chữ đỏ)
i =ws .Range("B" & Rows.Count).End(xlUp).Row
em đã xóa bớt ", ws As Worksheet"
nhưng nó vẫn báo lỗi dòng trên với lỗi " Syntax error"
Nhờ anh nhé

Xin lỗi. Do mình online trên điện thoại. Không test được. Mình bảo bạn logic theo hướng thử coi. Chứ đoán viết trên điện thoại chắc lỗi mà

LienDong · 29/8/20

buiquangthuan đã viết:
Xin lỗi. Do mình online trên điện thoại. Không test được. Mình bảo bạn logic theo hướng thử coi. Chứ đoán viết trên điện thoại chắc lỗi mà

Vậy khi nào bạn ngồi máy tính thì kiểm tra lại giúp, em cũng sửa nhưng không được

Maika8008 · 29/8/20

LienDong đã viết:
bạn cho hỏi cách dùng F9, F8 để kiểm tra lỗi như thế nào?

Ủa chớ không biết cách chạy từng dòng lệnh một à? Thế thì dùng VBA bao lâu rồi?

LienDong · 29/8/20

Maika8008 đã viết:
Ủa chớ không biết cách chạy từng dòng lệnh một à? Thế thì dùng VBA bao lâu rồi?

Lâu lâu có thời gian và cần thì mới lên đây để tham khảo thôi

Bài đã được tự động gộp: 29/8/20

LienDong đã viết:
Nó báo lỗi ở dòng (khi copy vào module đã hiện chữ đỏ)
i =ws .Range("B" & Rows.Count).End(xlUp).Row

Nó báo lỗi đỏ là dư 1 khoảng trắng sau Ws
Nhưng sau khi sửa lại thì nó vẫn báo lỗi không đúng ( báo lỗi sai như bài đầu tiên)

Maika8008 · 29/8/20

LienDong đã viết:
Lâu lâu có thời gian và cần thì mới lên đây để tham khảo thôi

Bài đã được tự động gộp: 29/8/20

Nó báo lỗi đỏ là dư 1 khoảng trắng sau Ws
Nhưng sau khi sửa lại thì nó vẫn báo lỗi không đúng ( báo lỗi sai như bài đầu tiên)

Sai điều kiện, chúng phải thế này:
If cll.Value = "" Or (cll.Value <> "" And cll.Value <> "Y" And cll.Value <> "N") Then

LienDong · 30/8/20

Maika8008 đã viết:
Sai điều kiện, chúng phải thế này:
If cll.Value = "" Or (cll.Value <> "" And cll.Value <> "Y" And cll.Value <> "N") Then

Cách đặt điều kiện lạ quá, bạn giải thích 1 chút được không ạ!

Maika8008 · 30/8/20

LienDong đã viết:
Cách đặt điều kiện lạ quá, bạn giải thích 1 chút được không ạ!

Sao lại lạ? Thế mới đúng chớ.

Đầu tiên = "" thì báo lỗi nhé. Ok?
Hoặc nếu khác rỗng thì mới xét kèm đồng thời phải khác Y và khác N.

HieuCD · 30/8/20

LienDong đã viết:
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ị

Thử code

Mã:

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$
 
  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
      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
              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 "Sheet " & NameSh & " Ô: " & wSh.Cells(i, j).Address
                  End If
                Next j
              Next i
              Exit For
            End If
          Next n
        Next wSh
      wB.Close False
    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

LienDong · 30/8/20

HieuCD đã viết:

Thử code

Mã:

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$

  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
      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
              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 "Sheet " & NameSh & " Ô: " & wSh.Cells(i, j).Address
                  End If
                Next j
              Next i
              Exit For
            End If
          Next n
        Next wSh
      wB.Close False
    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

Cách bạn làm khác quá , để nghiên cứu thêm
cho em hỏi thêm trong câu lệnh
MsgBox "Sheet " & NameSh & " Ô: " & wSh.Cells(i, j).Address
Em muốn nó thông báo thêm "Ten File" được không? vì các File có tên sheet như nhau nên khó nhận diện là ở file nào?

HieuCD · 30/8/20

LienDong đã viết:
Cách bạn làm khác quá , để nghiên cứu thêm
cho em hỏi thêm trong câu lệnh
MsgBox "Sheet " & NameSh & " Ô: " & wSh.Cells(i, j).Address
Em muốn nó thông báo thêm "Ten File" được không? vì các File có tên sheet như nhau nên khó nhận diện là ở file nào?

Thêm bẩy lỗi

Mã:

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

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

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

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

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

Thành viên gạo cội

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

Thành viên gạo cội

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

Thành viên gạo cội

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

Thành viên gạo cội

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

Thành viên gạo cội

Chuyên gia GPE

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

Chuyên gia GPE