VBA/Excel/Access/Word/Excel/ActiveCell

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

Содержание

Accesses the PROPER( ) function through the Application.WorksheetFunction object.

   <source lang="vb">

    Sub FixText()
       ActiveCell.Value = Application.WorksheetFunction.Proper("asdf")
    End Sub
</source>
   
  


Activate Change

   <source lang="vb">

Sub DownTen()

  ActiveCell.Offset(10, 0).Select

End Sub

</source>
   
  


Activate Next Blank Down

   <source lang="vb">

Sub ActivateNextBlankDown()

   ActiveCell.Offset(1, 0).Select
   Do While Not IsEmpty(ActiveCell)
       ActiveCell.Offset(1, 0).Select
   Loop

End Sub

</source>
   
  


Activate Next Blank To Right

   <source lang="vb">

Sub ActivateNextBlankToRight()

   ActiveCell.Offset(0, 1).Select
   Do While Not IsEmpty(ActiveCell)
       ActiveCell.Offset(0, 1).Select
   Loop

End Sub

</source>
   
  


a Do-Loop Until loop with IsEmpty

   <source lang="vb">

Sub DoLoopUntilDemo()

   Do
       ActiveCell.value = ActiveCell.value * 2
       ActiveCell.offset(1, 0).Select
   Loop Until IsEmpty(ActiveCell.value)

End Sub

</source>
   
  


Check the existence of ActiveCell

   <source lang="vb">

Sub activeCell()

   If ActiveCell Is Nothing Then End

End Sub

</source>
   
  


Copy the value from the variable into the cell on the right.

   <source lang="vb">

    Sub SwapTextWithCellOnRight()
        Dim CellContent
        CellContent = ActiveCell.Value
        ActiveCell.Offset(0, 1).Value = CellContent
    End Sub
</source>
   
  


Do-Until loop and IsEmpty

   <source lang="vb">

Sub DoUntilDemo()

   Do Until IsEmpty(ActiveCell.value)
       ActiveCell.value = ActiveCell.value * 2
       ActiveCell.offset(1, 0).Select
   Loop

End Sub

</source>
   
  


Do-While loop with ActiveCell

   <source lang="vb">

Sub DoWhileDemo()

   Do While ActiveCell.value <> Empty
       ActiveCell.value = ActiveCell.value * 2
       ActiveCell.offset(1, 0).Select
   Loop

End Sub

</source>
   
  


Entering a Formula in a Cell

   <source lang="vb">

"Enters the formula =SUM($G$12:$G$22) in the active cell: Sub fomula()

   ActiveCell.Formula = "=SUM($G$12:$G$22)"

End Sub

</source>
   
  


Entering Text in the Current Cell

   <source lang="vb">

Sub MyMacro

  ActiveCell.Value = "Hello World!"

End Sub

</source>
   
  


Get the address of ActiveCell

   <source lang="vb">

Sub selectRange()

   MsgBox ActiveCell.Address

End Sub

</source>
   
  


Go to the Max

   <source lang="vb">

Sub GoToMax()

   Dim WorkRange As Range
   If TypeName(Selection) <> "Range" Then Exit Sub
   If Selection.Count = 1 Then
       Set WorkRange = Cells
   Else
       Set WorkRange = Selection
   End If
   MaxVal = Application.Max(WorkRange)
   
   On Error Resume Next
   WorkRange.Find(What:=MaxVal, _
       After:=WorkRange.Range("A1"), _
       LookIn:=xlValues, _
       LookAt:=xlPart, _
       SearchOrder:=xlByRows, _
       SearchDirection:=xlNext, MatchCase:=False _
       ).Select
   If Err <> 0 Then MsgBox "Max value was not found: " _
    & MaxVal

End Sub

</source>
   
  


If the value of the active cell is too big, change it

   <source lang="vb">

    Sub MyMacro()
        If ActiveCell.Value > 100 Then
            ActiveCell.Value = 100
        End If
    End Sub
</source>
   
  


Moves the active cell up two rows (RowOffset:=-2) and four columns to the right (ColumnOffset:=4):

   <source lang="vb">

Sub offset()

   ActiveCell.Offset(RowOffset:=-2, ColumnOffset:=4).Activate

End Sub

</source>
   
  


Move the active cell by using ActiveCell.Offset

   <source lang="vb">

Sub ActivateNextBlankToRight()

   ActiveCell.Offset(0, 1).Select
   Do While Not IsEmpty(ActiveCell)
       ActiveCell.Offset(0, 1).Select
   Loop

End Sub

</source>
   
  


Move to the new cell, you need to use the Activate or Select method

   <source lang="vb">

    Sub MyMacro()
        " Change the top cell.
        ActiveCell.Value = "Top cell"
        " Move down one cell.
        ActiveCell.Offset(1, 0).Select
        " Now this changes the bottom cell.
        ActiveCell.Value = "Bottom cell"
    End Sub
</source>
   
  


Moving to Other Cells

   <source lang="vb">

    Sub MyMacro()
        ActiveCell.Value = "Top cell"
        ActiveCell.Offset(1, 0) = "Bottom cell"
    End Sub
</source>
   
  


Repeating Actions with a Loop

   <source lang="vb">

    Sub FormatAllCellsInColumn()
        Do Until ActiveCell.Value = ""
            ActiveCell.Rows.EntireRow.Select
            Selection.Interior.ColorIndex = 35
            Selection.Interior.Pattern = xlSolid
            ActiveCell.Offset(2, 0).Select
        Loop
    End Sub
</source>
   
  


Select ActiveCell and cells to its Left

   <source lang="vb">

Sub SelectToLeft()

   Range(ActiveCell, ActiveCell.End(xlToLeft)).Select

End Sub

</source>
   
  


Select ActiveCell and cells to its Right

   <source lang="vb">

Sub SelectToRight()

   Range(ActiveCell, ActiveCell.End(xlToRight)).Select

End Sub

</source>
   
  


Select active cell and up to the end

   <source lang="vb">

Sub SelectUp()

   Range(ActiveCell, ActiveCell.End(xlUp)).Select

End Sub

</source>
   
  


Select ActiveCell"s range

   <source lang="vb">

Sub SelectCurrentRegion()

   ActiveCell.CurrentRegion.Select

End Sub

</source>
   
  


Select Current Region

   <source lang="vb">

Sub SelectCurrentRegion()

   ActiveCell.CurrentRegion.Select

End Sub

</source>
   
  


Select First To Last In Column

   <source lang="vb">

Sub SelectFirstToLastInColumn()

   Set TopCell = Cells(1, ActiveCell.Column)
   Set BottomCell = Cells(16384, ActiveCell.Column)
   If IsEmpty(TopCell) Then Set TopCell = TopCell.End(xlDown)
   If IsEmpty(BottomCell) Then Set BottomCell = BottomCell.End(xlUp)
   If TopCell.Row = 16384 And BottomCell.Row = 1 Then ActiveCell.Select Else Range(TopCell, BottomCell).Select

End Sub

</source>
   
  


Select First To Last In Row

   <source lang="vb">

Sub SelectFirstToLastInRow()

   Set LeftCell = Cells(ActiveCell.Row, 1)
   Set RightCell = Cells(ActiveCell.Row, 256)
   If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End(xlToRight)
   If IsEmpty(RightCell) Then Set RightCell = RightCell.End(xlToLeft)
   If LeftCell.Column = 256 And RightCell.Column = 1 Then ActiveCell.Select Else Range(LeftCell, RightCell).Select

End Sub

</source>
   
  


Store the location of the active cell and then return it to the stored location

   <source lang="vb">

Sub set()

   Set myActiveCell = ActiveCell
   Set myActiveWorksheet = ActiveSheet
   Set myActiveWorkbook = ActiveWorkbook
   
   "take actions here
   
   myActiveWorkbook.Activate
   myActiveWorksheet.Activate
   myActiveCell.Activate

End Sub

</source>
   
  


Swap Text With Cell On Right

   <source lang="vb">

    Sub SwapTextWithCellOnRight()
        Dim CellContent
        CellContent = ActiveCell.Value
        ActiveCell.Value = ActiveCell.Offset(0, 1).Value
    End Sub
</source>
   
  


Take the current text value, and add the message "INVALID: " before the text

   <source lang="vb">

Sub MyMacro

        ActiveCell.Value = "INVALID: " & ActiveCell.Value

End Sub

</source>
   
  


Toggles text wrap alignment for selected cells

   <source lang="vb">

Sub ToggleWrapText()

   If TypeName(Selection) = "Range" Then
     Selection.WrapText = Not ActiveCell.WrapText
   End If

End Sub

</source>
   
  


Use ActiveCell.Offset to move the curren selection

   <source lang="vb">

Sub ActivateNextBlankDown()

   ActiveCell.Offset(1, 0).Select
   Do While Not IsEmpty(ActiveCell)
       ActiveCell.Offset(1, 0).Select
   Loop

End Sub

</source>
   
  


Use ActiveCell.SpecialCells(xlLastCell)

   <source lang="vb">

Sub SelectActiveArea()

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

End Sub

</source>
   
  


Use all the ordinary numeric operators, like +, -, /, *, and ^.

   <source lang="vb">

Sub MyMacro

        ActiveCell.Value = (ActiveCell.Value * 2) - 1

End Sub

</source>
   
  


Use Do Loop While to change ActiveCell value

   <source lang="vb">

Sub DoLoopWhileDemo()

   Do
       ActiveCell.value = ActiveCell.value * 2
       ActiveCell.offset(1, 0).Select
   Loop While ActiveCell.value <> Empty

End Sub

</source>
   
  


Use if, ElseIf and Else with ActiveCell

   <source lang="vb">

    Sub MyMacro()
        If ActiveCell.Value > 1000 Then
            ActiveCell.Offset(0, 1).Value = ActiveCell.Value * 0.05
        ElseIf ActiveCell.Value > 500 Then
            ActiveCell.Offset(0, 1).Value = ActiveCell.Value * 0.025
        Else
            ActiveCell.Offset(0, 1).Value = 5
        End If
    End Sub
</source>
   
  


Uses the EntireColumn property, which returns a Range object that consists of a full column:

   <source lang="vb">

Sub SelectColumn()

   ActiveCell.EntireColumn.Select

End Sub

</source>
   
  


Working with the Region around the Active Cell

   <source lang="vb">

Sub font()

   With ActiveCell.CurrentRegion.Font
       .Name = "Times New Roman"
       .Size = 12
       .Bold = False
       .Italic = False
   End With

End Sub

</source>