實(shí)例03-按數(shù)值范圍標(biāo)記行

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 "參數(shù)不能為空"

? ? ?Exit Sub

? ? ?End If

On Error GoTo 處理出錯(cuò)

'定義變量

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)

'獲得數(shù)據(jù)區(qū)域最大行號

Dim rmax As Long

Dim cmax As Long

rmax = .UsedRange.Cells(.UsedRange.Count).Row

'循環(huán)判斷（反向）

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

? ? ? ? '標(biāo)記單元格

'? ? ? ? .Cells(i, matchcolumn).Interior.ColorIndex = backcolornum

'? ? ? ? .Cells(i, matchcolumn).Font.ColorIndex = fontcolornum

? ? ? ? '標(biāo)記整行

? ? ? ? ? ? .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

處理出錯(cuò):

MsgBox Err.Description

End Sub

實(shí)例04-按數(shù)值范圍標(biāo)記列

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 "參數(shù)不能為空"

? ? ?Exit Sub

? ? ?End If

On Error GoTo 處理出錯(cuò)

'定義變量

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)

'獲得數(shù)據(jù)區(qū)域最大列號

Dim cmax As Long

cmax = .UsedRange.Cells(.UsedRange.Count).Column

'循環(huán)判斷（反向）

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

? ? ? ? '標(biāo)記單元格

? ? ? ? .Cells(matchrow, i).Interior.ColorIndex = backcolornum

? ? ? ? .Cells(matchrow, i).Font.ColorIndex = fontcolornum

? ? ? ? '標(biāo)記整列

'? ? ? ? ? ? .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

處理出錯(cuò):

MsgBox Err.Description

End Sub