完美Excel

Sub sample01()
    Worksheets("Sheet1").UsedRange.Select
End Sub

Dim cellRange As Range,RowNum As Long,ColNum As Long
Set cellRange=Worksheets("Sheet1").UsedRange '设置已用单元格区域并赋值给变量
RowNum=cellRange.Rows.Count '已用单元格区域的行数
ColNum=cellRange.Columns.Count '已用单元格区域的列数
<span style="color: #0000ff;">UsedRange属性应用示例</span>
现在，我们举几个例子，进一步说明UsedRange属性的用法。
<span style="color: #0000ff;">[示例一]</span>下面的程序在活动工作表已使用单元格区域中，当该区域不包含任何公式时，清除该区域不能打印的字符。其中，ActiveSheet.UsedRange 代表当前工作表中已使用单元格区域组成的Range对象。(By Chip Pearson)
<pre lang="vb">
Sub CleanUp()
    Dim TheCell As Range
    For Each TheCell In ActiveSheet.UsedRange
      With TheCell
          If .HasFormula = False Then
              .Value = Application.WorksheetFunction.Clean(.Value)
          End If
      End With
    Next TheCell
End Sub

Public Sub Delete_First_Character(Optional ByRef objRange As Range = Nothing)
    Dim objCell As Range
    On Error Resume Next
 
    If (objRange Is Nothing) Then
       Set objRange = Application.InputBox(Prompt:="请选择单元格区域", _
          Title:="删除第一个字符", _
          Type:=8, _
          Default:=ActiveSheet.UsedRange.Address) '设置缺省选区为已用区域
    End If
 
    Err.Clear
 
    Set objRange = objRange.SpecialCells(xlCellTypeConstants)
 
    If (Err.Number <> 0&) Or (objRange Is Nothing) Then
        MsgBox "在指定的单元格区域中没有符合要求的单元格.", _
          vbExclamation Or vbOKOnly, _
          ActiveWorkbook.Name
        Exit Sub
    End If
 
    On Error GoTo Exit_Delete_First_Character
 
    Application.ScreenUpdating = False
 
    For Each objCell In objRange
        objCell = Mid$(objCell, 2)
    Next objCell
 
Exit_Delete_First_Character:
 
    On Error Resume Next
 
    Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click()
    Dim r As Long
 
    For r = UsedRange.Rows.Count To 1 Step -1
        If Range("E" & r) = "finish" Then _
            Range("A:G").Rows(r).Interior.ColorIndex = 10
        Next r
 
    For r = UsedRange.Rows.Count To 1 Step -1
        If Range("E" & r) = "" Then _
            Range("A:G").Rows(r).Interior.ColorIndex = 2
    Next r
End Sub

Sub Find_AND()
    Dim rng As Range
    Dim what As String
    what = "AND"
    Do
        Set rng = ActiveSheet.UsedRange.Find(what)
        If rng Is Nothing Then
            Exit Do
        Else
           Rows(rng.Row).Delete
        End If
    Loop
End Sub

Sub EndxlUp_OneColLastRow()
    If Range("A" & Rows.Count).End(xlUp) = Empty Then GoTo Finish
    '获取最后一行
    MsgBox "最后一行是第" & Range("A" & Rows.Count).End(xlUp).Row & "行."
    Exit Sub
Finish:
    MsgBox "没有发现公式或数据! "
End Sub

Sub NextRowInColumnUsedAsSub()
    '包含所有数据和公式，忽略隐藏的最后一行
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
End Sub

Sub NextRowInColumnUsedAsFunction()
    '包含所有数据和公式，忽略隐藏的最后一行
    Range("A" & LastRowInColumn("A") + 1).Select
End Sub
 
Public Function LastRowInColumn(Column As String) As Long
     LastRowInColumn = Range(Column & Rows.Count).End(xlUp).Row
End Function

Sub Find_LastRowxlValues()
    On Error GoTo Finish
    '获取最后一行
    MsgBox "最后一行是第" & Cells.Find("*", _
      SearchOrder:=xlByRows, LookIn:=xlValues, _
      SearchDirection:=xlPrevious).EntireRow.Row & "行"
    Exit Sub
Finish:
    MsgBox "没有发现数值！"
End Sub

Sub Find_LastRowxlFormulas()
    On Error GoTo Finish
    '获取最后一行
    MsgBox "最后一行是第" & Cells.Find("*", _
      SearchOrder:=xlByRows, LookIn:=xlFormulas, _
      SearchDirection:=xlPrevious).EntireRow.Row & "行"
    Exit Sub
Finish:
    MsgBox "没发现数值或公式！"
End Sub

Sub NextRowUsedAsSub()
    '选取最后一行的下一行
    Range("A" & Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row + 1).Select
End Sub

Sub NextRowUsedAsFunction()
    '选取最后一行的下一行(调用函数)
    Range("A" & LastRow + 1).Select
End Sub
 
Public Function LastRow() As Long
    '本代码包含隐藏行
    '使用常量xlFormulas，因为常量xlValues会忽略隐藏的最后一行
    LastRow = Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row
End Function

'当最后一行为公式或隐藏了最后行时，会忽略，即认为倒数第二行为最后一行
Sub NextConstantRowFunction()
Range("A" & LastConstantRow(True, True, True, True) + 1).Select
End Sub
 
Public Function LastConstantRow(Optional IncludeText As Boolean, _
                               Optional IncludeNumbers As Boolean, _
                               Optional IncludeErrors As Boolean, _
                               Optional IncludeLogicals As Boolean) As Long
   Dim Text As Long, Numbers As Long, Errors As Long
Dim Logical As Long, AllTypes As Long
   If IncludeText Then Text = xlTextValues Else Text = 0
   If IncludeNumbers Then Numbers = xlNumbers Else Numbers = 0
   If IncludeErrors Then Errors = xlErrors Else Errors = 0
   If IncludeLogicals Then Logical = xlLogical Else Logical = 0
   AllTypes = Text + Numbers + Errors + Logical
   On Error GoTo Finish
   LastConstantRow = Split(Cells.SpecialCells(xlCellTypeConstants, AllTypes).Address, "$") _
       (UBound(Split(Cells.SpecialCells(xlCellTypeConstants, AllTypes).Address, "$")))
     Exit Function
Finish:
     MsgBox "没有发现数据！"
End Function

'查找含有公式的单元格所在的行，忽略该行以后的常量和隐藏的行
Sub NextFormulaRowFunction()
     Range("A" & LastFormulaRow(True, True, True, True) + 1).Select
End Sub
 
Public Function LastFormulaRow(Optional IncludeText As Boolean, _
                               Optional IncludeNumbers As Boolean, _
                               Optional IncludeErrors As Boolean, _
                               Optional IncludeLogicals As Boolean) As Long
    Dim Text As Long, Numbers As Long, Errors As Long
    Dim Logical As Long, AllTypes As Long
    If IncludeText Then Text = xlTextValues Else Text = 0
    If IncludeNumbers Then Numbers = xlNumbers Else Numbers = 0
    If IncludeErrors Then Errors = xlErrors Else Errors = 0
    If IncludeLogicals Then Logical = xlLogical Else Logical = 0
    AllTypes = Text + Numbers + Errors + Logical
    On Error GoTo Finish
    LastFormulaRow = Split(Cells.SpecialCells(xlCellTypeFormulas, AllTypes).Address, "$") _
      (UBound(Split(Cells.SpecialCells(xlCellTypeFormulas, AllTypes).Address, "$")))
    Exit Function
Finish:
    MsgBox "没有发现数据！"
End Function

Sub SpecialCells_LastRowxlCellTypeConstants()
   Dim MyRow As Range
   On Error GoTo Finish
   Set MyRow = Intersect([A:A], Cells. _
   SpecialCells(xlCellTypeConstants).EntireRow).EntireRow
   '获取最后一行
   MsgBox "最后一行是第" & Split(MyRow.Address, "$") _
   (UBound(Split(MyRow.Address, "$"))) & "行"
   Set MyRow = Nothing
   Exit Sub
Finish:
   MsgBox "没有发现数据！"
End Sub

Sub SpecialCells_LastRowxlCellTypeNumberConstants()
   Dim MyRow As Range
   On Error GoTo Finish
   Set MyRow = Intersect([A:A], Cells. _
   SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow)
   '获取最后一行
   MsgBox "最后一行是第" & Split(MyRow.Address, "$") _
   (UBound(Split(MyRow.Address, "$"))) & "行"
   Set MyRow = Nothing
   Exit Sub
Finish:
   MsgBox "没有发现数据！"
End Sub

Sub SpecialCells_LastRowxlCellTypeTextConstants()
   Dim MyRow As Range
   On Error GoTo Finish
   Set MyRow = Intersect([A:A], Cells. _
   SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow)
   '获取最后一行
   MsgBox "最后一行是第" & Split(MyRow.Address, "$") _
   (UBound(Split(MyRow.Address, "$"))) & "行"
   Set MyRow = Nothing
   Exit Sub
Finish:
   MsgBox "没有发现数据！"
End Sub

Sub SpecialCells_LastRowxlCellTypeFormulas()
   Dim MyRow As Range
   On Error GoTo Finish
   Set MyRow = Intersect([A:A], Cells. _
   SpecialCells(xlCellTypeFormulas).EntireRow).EntireRow
   '获取最后一行
   MsgBox "最后一行是第" & Split(MyRow.Address, "$") _
   (UBound(Split(MyRow.Address, "$"))) & "行"
   Set MyRow = Nothing
   Exit Sub
Finish:
   MsgBox "没有发现数据！"
End Sub

Sub NextUsedRowSub()
    ' 选取可见的最后一行的下一行
    Range("A" & Cells.SpecialCells(xlCellTypeLastCell).Row + 1).Select
End Sub

Sub NextUsedRowFunction()
    Range("A" & LastUsedRow + 1).Select
End Sub
 
Public Function LastUsedRow() As Long
    LastUsedRow = Cells.SpecialCells(xlCellTypeLastCell).Row
End Function