VB脚本，用于识别excel中不同行和列中缺少的强制单元格值

Question

我有一个excel文件，包含20列和100行，如果A2中的值=可报告，excel中的某些列是强制性的，类似地，如果A2=不可报告，则某些其他列值是强制性的，因此，需要一个VB脚本来检查这个条件，如果任何强制性的列单元格值为空，那么在保存excel文件时会抛出一条错误消息，错误消息应该列出所有丢失的列标题和行。脚本应该验证所有的行，尝试了下面的代码，但没有工作，而且我得到了多个错误消息，而不是单个错误消息

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Cell As Range
Dim flag As Boolean
flag = False
If Cells(1, 1) = "" Then flag = True
For Each Cell In Range("B2:B3")
If Cell = "" Then
MsgBox ("Signoff is missing")
flag = True
Exit For
End If
Next Cell
For Each Cell In Range("D2:D3")
If Cell = "" Then
MsgBox ("tax Regime value is missing")
flag = True
Exit For
End If
Next Cell
For Each Cell In Range("E2:E3")
If Cell = "" Then
MsgBox ("Classification value is missing")
flag = True
Exit For
End If
Next Cell
Cancel = flag
End Sub

Answer 1

更新-添加error.txt作为输出

update2-将单元格染成红色并创建错误表

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet, lastrow As Long, ar(2)
Dim msg As String, c As String
Dim r As Long, i As Long, n As Long

ar(1) = Array("B", "D", "F") ' non-reportable columns
ar(2) = Array("C", "E", "G") ' reportable columns

Set ws = ActiveSheet
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For r = 2 To lastrow
.Rows(r).Cells.Interior.Pattern = xlNone
n = 0
If LCase(.Cells(r, "A")) = "non-reportable" Then
n = 1
ElseIf LCase(.Cells(r, "A")) = "reportable" Then
n = 2
End If
If n > 0 Then
For i = 0 To UBound(ar(n))
c = ar(n)(i)
If .Cells(r, c) = "" Then
.Cells(r, c).Interior.Color = RGB(255, 0, 0) ' red
msg = msg & vbLf & "Row " & r & " missing " & .Cells(1, c)
End If
Next
End If
Next
End With

Dim wsErr As Worksheet, arErr
If Len(msg) > 0 Then

' create error sheet
arErr = Split(msg, vbLf)
Set wsErr = Sheets.Add(after:=Sheets(Sheets.Count))
wsErr.Name = "Errors " & Format(Now(), "yyyy-mm-dd hhmmss")
wsErr.Cells(1, 1).Resize(UBound(arErr) + 1) = Application.Transpose(arErr)

Open "errors.txt" For Output As #1
Print #1, msg
Close #1
MsgBox "Missing data see error.txt", vbCritical
Cancel = True
Else
MsgBox "All good"
End If
End Sub