VBA/Excel/Access/Word/Excel/SpecialCells

Материал из VB Эксперт
Версия от 12:47, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

Constants for the Value Argument for the SpecialCells Method

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



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

 
     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



Delete numbers

 
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



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

 
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



Determines the last row and column in the worksheet:

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



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

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



Process the formulas

 
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



Select Active Area

 
Sub SelectActiveArea()
    Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select
End Sub



Select Comment Cells

 
Sub SelectCommentCells()
    Cells.SpecialCells(xlCellTypeComments).Select
End Sub



Selecting with SpecialCells

 
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



Using Error Handling When Using SpecialCells

 
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



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.

 
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