【实例03-按数值范围标记行】【实例04-按数值范围标记列】
实例03-按数值范围标记行
Private Sub CommandButton处理_Click()
'判断工作簿名，工作表名不为空
With ThisWorkbook.Worksheets("操作界面")
If Trim(.Cells(2, "C").Value) = "" Or Trim(.Cells(6, "C").Value) = "" Or Trim(.Cells(10, "C").Value) = "" _
Or Trim(.Cells(18, "C").Value) = "" Or Trim(.Cells(22, "C").Value) = "" Or Trim(.Cells(14, "C").Value) = "" Or Trim(.Cells(14, "D").Value) = "" Then
MsgBox "参数不能为空"
Exit Sub
End If
On Error GoTo 处理出错
'定义变量
Dim wbname As String
Dim shname As String
wbname = Trim(.Cells(2, "C").Value)
shname = Trim(.Cells(6, "C").Value)
Dim matchcolumn As Long
Dim startnum As Long
Dim stopnum As Long
matchcolumn = Trim(.Cells(10, "C").Value)
startnum = Trim(.Cells(14, "C").Value)
stopnum = Trim(.Cells(14, "D").Value)
Dim backcolornum As Integer
Dim fontcolornum As Integer
backcolornum = Trim(.Cells(18, "C").Value)
fontcolornum = Trim(.Cells(22, "C").Value)
End With
'处理表格
With Workbooks(wbname).Worksheets(shname)
'获得数据区域最大行号
Dim rmax As Long
Dim cmax As Long
rmax = .UsedRange.Cells(.UsedRange.Count).Row
'循环判断（反向）
Dim i
For i = 1 To rmax
If IsNumeric(.Cells(i, matchcolumn)) = True Then
If CDbl(.Cells(i, matchcolumn)) >= startnum And CDbl(.Cells(i, matchcolumn)) <= stopnum Then
'标记单元格
' .Cells(i, matchcolumn).Interior.ColorIndex = backcolornum
' .Cells(i, matchcolumn).Font.ColorIndex = fontcolornum
'标记整行
.Rows(i).Interior.ColorIndex = backcolornum
.Rows(i).Font.ColorIndex = fontcolornum
End If
End If
Next i
End With
MsgBox "处理完成"
Workbooks(wbname).Activate
ActiveWindow.WindowState = xlMaximized
Workbooks(wbname).Worksheets(shname).Activate
Workbooks(wbname).Worksheets(shname).Cells(1, 1).Select
Exit Sub
处理出错:
MsgBox Err.Description
End Sub
实例04-按数值范围标记列
Private Sub CommandButton处理_Click()
'判断工作簿名，工作表名不为空
With ThisWorkbook.Worksheets("操作界面")
If Trim(.Cells(2, "C").Value) = "" Or Trim(.Cells(6, "C").Value) = "" Or Trim(.Cells(10, "C").Value) = "" _
Or Trim(.Cells(18, "C").Value) = "" Or Trim(.Cells(22, "C").Value) = "" Or Trim(.Cells(14, "C").Value) = "" Or Trim(.Cells(14, "D").Value) = "" Then
MsgBox "参数不能为空"
Exit Sub
End If
On Error GoTo 处理出错
'定义变量
Dim wbname As String
Dim shname As String
wbname = Trim(.Cells(2, "C").Value)
shname = Trim(.Cells(6, "C").Value)
Dim matchrow As Long
Dim startnum As Long
Dim stopnum As Long
matchrow = Trim(.Cells(10, "C").Value)
startnum = Trim(.Cells(14, "C").Value)
stopnum = Trim(.Cells(14, "D").Value)
Dim backcolornum As Integer
Dim fontcolornum As Integer
backcolornum = Trim(.Cells(18, "C").Value)
fontcolornum = Trim(.Cells(22, "C").Value)
End With
'处理表格
With Workbooks(wbname).Worksheets(shname)
'获得数据区域最大列号
Dim cmax As Long
cmax = .UsedRange.Cells(.UsedRange.Count).Column
'循环判断（反向）
Dim i
For i = 1 To cmax
If IsNumeric(.Cells(matchrow, i)) = True Then
If CDbl(.Cells(matchrow, i)) >= startnum And CDbl(.Cells(matchrow, i)) <= stopnum Then
'标记单元格
.Cells(matchrow, i).Interior.ColorIndex = backcolornum
.Cells(matchrow, i).Font.ColorIndex = fontcolornum
'标记整列
' .Columns(i).Interior.ColorIndex = backcolornum
' .Columns(i).Font.ColorIndex = fontcolornum
End If
End If
Next i
End With
MsgBox "处理完成"
Workbooks(wbname).Activate
ActiveWindow.WindowState = xlMaximized
Workbooks(wbname).Worksheets(shname).Activate
Workbooks(wbname).Worksheets(shname).Cells(1, 1).Select
Exit Sub
处理出错:
MsgBox Err.Description
End Sub
