Question

马上开始，我是编码的新手，我的技能范围正在根据Google搜索进行修改。

我正在使用Excel 2010，并尝试使用VBA来避免使用条件格式。我正在使用的电子表格是一个包含31列的模板，其中20列是必需的。如果在任何给定行的其中一列中有条目，则必须填写其他19个单元格，然后才能保存文件。

我正在尝试执行类似的功能来突出显示阻止文件保存的空白单元格。我知道我可以使用条件格式，但这需要它查看每行中的一个单元格，而不是该行中任何所需的单元格。我也知道它可以做多种条件格式，但我知道层数越多，电子表格的运行速度就越慢。

这可能吗？我所强制的列是A-D，F-K，M-N，S-Y＆amp; AE。如果它是一个因素，我已经附加了我用来强制输入的代码一旦填充了这些列：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim ws As Worksheet
    Dim rg As Range, c As Range
    Dim bCanSave As Boolean
    Dim sWarning As String

    Set ws = Sheets("Main")
    Set rg = ws.Range("A2:A10000,B2:B10000,C2:C10000,D2:D10000,F2:F10000,G2:G10000,H2:H10000,J2:J10000,K2:K10000,N2:N10000,S2:S10000,T2:T10000,U2:U10000,V2:V10000,W2:W10000,X2:X10000,Y2:Y10000,AE2:AE10000")
    sWarning = "File not saved!" & vbNewLine & "Mandatory cells missing in rows: " & vbNewLine

    With ws
        bCanSave = True
        For Each c In rg
            If Not IsEmpty(c) Then
                If .Cells(c.Row, "A") = "" Or .Cells(c.Row, "B") = "" Or .Cells(c.Row, "C") = "" Or .Cells(c.Row, "D") = "" Or .Cells(c.Row, "F") = "" Or .Cells(c.Row, "G") = "" Or .Cells(c.Row, "H") = "" Or .Cells(c.Row, "I") = "" Or .Cells(c.Row, "J") = "" Or .Cells(c.Row, "K") = "" Or .Cells(c.Row, "N") = "" Or .Cells(c.Row, "S") = "" Or .Cells(c.Row, "T") = "" Or .Cells(c.Row, "U") = "" Or .Cells(c.Row, "V") = "" Or .Cells(c.Row, "W") = "" Or .Cells(c.Row, "X") = "" Or .Cells(c.Row, "Y") = "" Or .Cells(c.Row, "AE") = "" Then
                    bCanSave = False
                    sWarning = sWarning & c.Row & ","
                End If
            End If
        Next c
    End With

    If Not bCanSave Then
        MsgBox sWarning, vbExclamation
        Cancel = True
    End If
End Sub

Answer 1

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Const CHECK_RNG As String = "A1:D1,F1:K1,M1:M1,S1:Y1,AE1"
    Dim ws As Worksheet
    Dim rg As Range
    Dim bCanSave As Boolean, sep As String
    Dim sWarning As String, sMissing As String, r As Long, ct As Long

    Set ws = Sheets("Main")

    sWarning = "File not saved!" & vbNewLine & "Mandatory cells missing in rows: " & vbNewLine
    bCanSave = True

    For r = 2 To 10000
        Set rg = ws.Rows(r).Range(CHECK_RNG)
        rg.Interior.ColorIndex = xlNone '<< clear any previous fill
        ct = Application.CountA(rg)
        If ct > 0 And ct <> rg.Cells.Count Then
            rg.SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow '<< fill empty
            bCanSave = False
            sMissing = sMissing & sep & r
            sep = ","
        End If
    Next r

    If Not bCanSave Then
        MsgBox sWarning & sMissing, vbExclamation
        Cancel = True
    End If
End Sub

Excel VBA条件格式化行中的空白单元格

1 个答案: