excel中强制单元格的验证总结

Question

I have got an excel workbook, it has 5 static tabs and more tabs can be created using a template tab. In each tab there is a certain field or a range that is mandatory to be filled out also in the new created tabs (might be up to 60).

My question is how can I go about seeing in, lets say in mainsheet, a summary which shows me:

1. Which tab has missing fields
2. Which fields is missing (an address of a cell)

I tried naming the range "MyRange" and counting if the cells are non blank. But this will not work for the newly created sheets.

I also tried a conditional formatting but again this will not give me a summary.

In the meantime I also bumped into a sort of solution but this is also not the thing I am looking for:

Sub listEmptyCells()

    Dim emptyAddresses() As String
    Dim i As Long
    Dim ws As Worksheet
    Dim rng As Range
    
    Set ws = Sheets("1.Data Source") ' CHANGE AS NECESSARY
    Set rng = ws.Range("B30:B32")
    
    If WorksheetFunction.CountBlank(rng) = 0 Then
        MsgBox ("No empty cells in the range")
        Exit Sub
    End If
    
    emptyAddresses() = Split(rng.SpecialCells(xlCellTypeBlanks).Address, ",")
    
    For i = LBound(emptyAddresses) To UBound(emptyAddresses)
        ws.Cells(i + 1, 2).Value = emptyAddresses(i)
    Next i

End Sub

Your help and guidance here would be highly appreciated

All the best Jacek

Answer 1

Here's one approach:

Sub listEmptyCells()
    Const CHECK_RANGE As String = "B30:B32" 'range to locate empty cells in

    Dim i As Long, r As Long, rngCheck As Range, rngEmpty As Range
    Dim ws As Worksheet, wb As Workbook, wsSummary As Worksheet
    Dim rwSummary As Range, s As String, c As Range

    Set wb = ThisWorkbook
    Set wsSummary = wb.Worksheets("Summary")
    Set rwSummary = wsSummary.Range("A2:B2") 'first row of results
    rwSummary.Resize(wb.Worksheets.Count).Clear 'remove previous results

    For i = 1 To wb.Worksheets.Count
        Set ws = wb.Worksheets(i)
        If ws.Name <> wsSummary.Name Then 'exclude specific sheet(s)
            
            s = ""
            Set rngEmpty = Nothing

            'which range to check - special case or use default?
            Select Case ws.Name
                Case "Sheet One": Set rngCheck = ws.Range("A1:A10")
                Case "Sheet Two": Set rngCheck = ws.Range("G34:G56,H10")
                Case Else: Set rngCheck = ws.Range(CHECK_RANGE) 'default range
            End Select
            
            'loop cells in check range
            For Each c In rngCheck.Cells
                If Len(c.Value) = 0 Then
                    If rngEmpty Is Nothing Then
                        Set rngEmpty = c
                    Else
                        Set rngEmpty = Application.Union(rngEmpty, c)
                    End If
                End If
            Next c
            If Not rngEmpty Is Nothing Then
                s = rngEmpty.Count & " required cell(s) not filled:" & _
                   rngEmpty.Address(False, False)
            End If

            With rwSummary 'record results
                .Cells(1).Value = ws.Name
                .Cells(2).Value = IIf(s <> "", s, "OK")
                .Font.Color = IIf(s <> "", vbRed, vbGreen)
            End With
            Set rwSummary = rwSummary.Offset(1, 0) 'next summary row
        End If
    Next i
End Sub