VBA如果单元格小于一定长度，突出显示并显示消息

Posted 2023-03-06

【中文标题】VBA如果单元格小于一定长度，突出显示并显示消息

【英文标题】：VBA If cell is under a certain length, highlight and display message

【发布时间】：2013-08-15 18:31:33

【问题描述】：

我正在尝试编写一个宏来检查 Excel 电子表格中的某个列，查找小于 9 个字符但大于 2 个字符的条目，如果找到，则显示一条消息并突出显示找到该值的单元格。它可能会发生多次。我写了以下代码：

Sub Highlight()
Dim c As Range
Dim LR As Integer
Dim intCell As Long
LR = Worksheets("Basket").Cells(Rows.Count, 6).End(xlUp).Row
For intCell = 1 To 8
For Each c In Range("G20:G" & LR).Cells
    If Len(c.Value) < 9 And Len(c.Value) > 2 Then
    MsgBox "One or more of the codes is invalid.  Correct the highlighted values."
    c.Cells(intCell).Interior.Color = vbYellow
    End If
Next
Next
End Sub

我不知道我做错了什么。任何帮助将不胜感激。

【问题讨论】：

那么实际行为与预期行为有什么区别？

+1 到 pnuts 建议。

【参考方案1】：

只是猜测您要突出显示的内容

Sub Highlight()
Dim c As Range
Dim LR As Integer
Dim numProbs as long
Dim sht as Worksheet

Set sht=Worksheets("Basket")

numProbs=0
LR = sht.Cells(Rows.Count, "G").End(xlUp).Row
For Each c In sht.Range("G20:G" & LR).Cells
    If Len(c.Value) < 9 And Len(c.Value) > 2 Then
        c.entirerow.cells(1).Resize(1,8).Interior.Color = vbYellow
        numProbs=numProbs+1
    End If
Next

if numProbs>0 Then
    msgbox "There were issues with " & numProbs & " rows. See yellow cells"
end if 


End Sub

【参考方案2】：

试试下面的代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:a10")) Is Nothing Then
     If Len(Target) <= 9 And Len(Target) >= 2 Then
     MsgBox " Length of string is " & Len(Target)
     Target.Font.Bold = True
     End If
End If
End Sub

我已使用范围 A1:A10 进行试验。

【参考方案3】：

这将遍历所有包含任何内容的单元格，为超出范围的单元格着色，并警告有多少单元格不正确。

Dim sheetName As String
Dim startRow As Integer, startCol As Integer
Dim endRow As Integer, endCol As Integer
Dim row As Integer, col As Integer
Dim c As Integer

sheetName = "Sheet1" 'Your sheetname

With Sheets(sheetName)

    startRow = 1 'start row for the loop
    startCol = 1 'start column for the loop

    endRow = .UsedRange.SpecialCells(xlCellTypeLastCell).row 'Last Used Row
    endCol = .UsedRange.SpecialCells(xlCellTypeLastCell).Column 'Last Used Column

    c = 0

    For row = startRow To endRow Step 1 'Loop through rows

        For col = startCol To endCol - 1 Step 1 'Loop through columns

            If Len(.Cells(row, col)) > 2 and Len(.Cells(row, col)) < 9 Then 'If value of cell is wrong

                .Cells(row, col).Interior.Color = vbYellow 'mark cell in red
                c = c + 1

            End If

        Next col
    Next row

    MsgBox "There were issues with " & c & " entries. See yellow cells" 'Warns that there are errors

End With