VBA/Excel/Access/Word/Excel/SpecialCells

Материал из VB Эксперт
Перейти к: навигация, поиск

Constants for the Value Argument for the SpecialCells Method

   <source lang="vb">

Returns Cells Containing xlErrors Errors xlLogical Logical values xlNumbers Numbers xlTextValues Text formulas

</source>
   
  


Copies all the numeric constants in the active sheet to blocks in the sheet named Constants, leaving an empty row between each block

   <source lang="vb">

    Sub CopyAreas()
        Dim rng As range, rngDestination As range
        Set rngDestination = Worksheets("Sheet1").range("A1")
        For Each rng In cells.SpecialCells(xlCellTypeConstants, xlNumbers).Areas
            rng.copy Destination:=rngDestination
            Set rngDestination = rngDestination.offset(rng.Rows.count + 1)
        Next rng
    End Sub
</source>
   
  


Delete numbers

   <source lang="vb">

Sub DeleteNumbers()

 Dim rng As Range
 For Each rng In Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
   If Not IsDate(rng.Value) Then rng.ClearContents
 Next rng

End Sub

</source>
   
  


Deletes all the numbers in a worksheet, leaving the formulas intact

   <source lang="vb">

Sub del()

    On Error Resume Next
    For Each rng In Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
        If Not IsDate(rng.Value) Then rng.ClearContents
    Next rng

End Sub

</source>
   
  


Determines the last row and column in the worksheet:

   <source lang="vb">

Sub rowCol()

    Set rngLast = Range("A1").SpecialCells(xlCellTypeLastCell)
    lLastRow = rngLast.Row
    lLastCol = rngLast.Column

End Sub

</source>
   
  


Identifies all the cells that contain formulas resulting in errors in the active worksheet:

   <source lang="vb">

Sub fomulaCell()

   ActiveSheet.Cells.SpecialCells(Type:=xlCellTypeFormulas, _
       Value:=xlErrors).Activate

End Sub

</source>
   
  


Process the formulas

   <source lang="vb">

Sub SkipBlanks()

   Dim ConstantCells As Range
   Dim FormulaCells As Range
   Dim cell As Range
   On Error Resume Next
   Set FormulaCells = Selection.SpecialCells(xlFormulas)
   For Each cell In FormulaCells
       If cell.Value > 0 Then
           cell.Interior.Color = vbRed
       End If
   Next cell

End Sub

</source>
   
  


Select Active Area

   <source lang="vb">

Sub SelectActiveArea()

   Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select

End Sub

</source>
   
  


Select Comment Cells

   <source lang="vb">

Sub SelectCommentCells()

   Cells.SpecialCells(xlCellTypeComments).Select

End Sub

</source>
   
  


Selecting with SpecialCells

   <source lang="vb">

Sub SpecialRange()

   Dim TheRange As Range
   Dim oCell As Range
   
       Set TheRange = Range("A1:Z200").SpecialCells(__
               xlCellTypeConstants, xlTextValues)
   
       For Each oCell In TheRange
           If oCell.Text = "Your Text" Then
               Debug.Print oCell.Address
               Debug.Print TheRange.Cells.Count
           End If
       Next oCell

End Sub

</source>
   
  


Using Error Handling When Using SpecialCells

   <source lang="vb">

Sub SpecialCells()

   Dim myWorksheet As Worksheet 
   Dim rgSpecial As Range 
   Dim rgCell As Range 
   On Error Resume Next 

   Set myWorksheet = ThisWorkbook.Worksheets("Sheet1") 
   Set rgSpecial = myWorksheet.Cells.SpecialCells(xlCellTypeFormulas, xlErrors) 
   If Not rgSpecial Is Nothing Then 
       rgSpecial.Interior.Color = vbRed 
   Else 
       Debug.Print myWorksheet.Name & " is an error-free worksheet." 
   End If 
   Set rgSpecial = Nothing 
   Set rgCell = Nothing 
   Set myWorksheet = Nothing 

End Sub

</source>
   
  


Using the SpecialCells method: uses the Set keyword to create two new Range objects: the selection"s subset that consists of cells with constants and the selection"s subset that consists of cells with formulas.

   <source lang="vb">

Sub SkipBlanks()

   Dim ConstantCells As Range
   Dim FormulaCells As Range
   Dim cell As Range
   On Error Resume Next
   Set ConstantCells = Selection.SpecialCells(xlConstants)
   For Each cell In ConstantCells
       If cell.Value > 0 Then
           cell.Interior.Color = vbRed
       End If
   Next cell

End Sub

</source>