VBA 如果单元格低于一定长度，则突出显示并显示消息
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18220997/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA If cell is under a certain length, highlight and display message
提问by user2611396
I'm trying to write a Macro that examines a certain column in an Excel spreadsheet looking for entries shorter than 9 characters but greater than 2, and if found, display a message and highlight the cell in which that value was found. It might happen multiple times. I have written the following code:
我正在尝试编写一个宏来检查 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
I can't figure out what I'm doing wrong. Any help would be greatly appreciated.
我无法弄清楚我做错了什么。任何帮助将不胜感激。
回答by Tim Williams
Just guessing at what you want to highlight
只是猜测你想突出什么
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
回答by rangan
Try the following code:
试试下面的代码：
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
I have used range A1:A10 for the trial.
我使用范围 A1:A10 进行试验。
回答by MRobinson
This will run over all the cells with anything in, colour in the ones out of your range, and warn how many cells are incorrect.
这将遍历所有包含任何内容的单元格，为超出范围的单元格着色，并警告有多少单元格不正确。
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
