生成文本指示行中哪些单元格为空

Question

我正在使用 VBA 在 Excel 中创建一个函数，以检查列中是否有空单元格。

例如，我需要检查 A 到 E 列中是否有空单元格。如果为空，则会用红色填充，然后在 J 列中添加注释，例如“A 列为空。请检查。”

我有用红色填充空单元格的代码。

如果同一行不同列有空单元格（如A列和B列），注释必须为“A、B列为空，请检查”。

我需要在现有评论中插入“, B”。

（注意：我创建的其他函数还有其他注释。）

'Add Error Comment to Column J

cellAddress= "J" & i
tgtValue = "column A is empty. Please check" 

If Range(cellAddress).Value = "" Then 
   Range(celladdress).Value = "->" + tgtValue

Elself Range(cellAddress).Value <> "" And InStr(1,Range(cellAddress).Value, tgtValue, vbTextCompare) = 0 Then
    Range(cellAddress).Value = Range(cellAddress).Value + " " + tgtvalue

End If

End If

Answer 1

首先，你的

Elself

语句有一个小写的l而不是大写的I（大写的它表示ELSELF）。

如果您分享更多代码，您可能会得到更好的答案，但根据您所拥有的内容，要添加“，B”，请尝试像这样分配新值：

Range(cellAddress).Value = Replace(Range(cellAddress).Value, " is empty", ",B is empty")

Answer 2

类似这样的：

Sub CheckEmpty()

    Dim rw As Range, msg, sep, c As Range, ws As Worksheet
    
    Set ws = ActiveSheet                     'for example
    Application.ScreenUpdating = False
    For Each rw In ws.Range("A2:E10").rows   'loop over rows in your range
        msg = ""                             'clear message and separator
        sep = ""
        For Each c In rw.Cells               'loop cells in row
            If Len(c.Value) = 0 Then         'empty?
                c.Interior.Color = vbRed
                'collect the column letter
                msg = msg & sep & Replace(c.Address(False, False), c.Row, "")
                sep = ", "         'populate separator after first value
            Else
                c.Interior.ColorIndex = xlNone 'OK - clear any fill
            End If
        Next c
        'add/clear message
        With ws.Cells(rw.Row, "J")
            .Value = IIf(Len(msg) > 0, "Column(s) " & msg & " should be populated", "")
        End With
    Next rw

End Sub

Answer 3

• A1:E10

  用于演示目的。您可以添加更多代码行来确定源数据范围。

Option Explicit
Sub DEMO()
    Dim rRow As Range, rCell As Range, rBlank As Range
    Dim sCol As String
    Const DATA_RNG = "A1:E10"  ' data range, modify as needed
    Const CMT_COL = "I" ' comment column
    Const CMT = "Column @ is empty. Please check" ' @ is a placeholder for columns
    Set rBlank = Range(DATA_RNG).SpecialCells(xlCellTypeBlanks) ' get the blank cells
    If Not rBlank Is Nothing Then
        For Each rRow In rBlank.Rows
            sCol = ""
            For Each rCell In rRow.Cells
                rCell.Interior.Color = vbRed
                sCol = sCol & "," & Split(rCell.Address, "$")(1)
            Next
            ' Update comment
            Cells(rRow.Cells(1).Row, CMT_COL) = Replace(CMT, "@", Mid(sCol, 2))
        Next
    End If
End Sub

微软文档：

替换功能

分割功能

Range.SpecialCells 方法 (Excel)