VBA/Excel/Access/Word/Excel/ActiveCell
Содержание
- 1 Accesses the PROPER( ) function through the Application.WorksheetFunction object.
- 2 Activate Change
- 3 Activate Next Blank Down
- 4 Activate Next Blank To Right
- 5 a Do-Loop Until loop with IsEmpty
- 6 Check the existence of ActiveCell
- 7 Copy the value from the variable into the cell on the right.
- 8 Do-Until loop and IsEmpty
- 9 Do-While loop with ActiveCell
- 10 Entering a Formula in a Cell
- 11 Entering Text in the Current Cell
- 12 Get the address of ActiveCell
- 13 Go to the Max
- 14 If the value of the active cell is too big, change it
- 15 Moves the active cell up two rows (RowOffset:=-2) and four columns to the right (ColumnOffset:=4):
- 16 Move the active cell by using ActiveCell.Offset
- 17 Move to the new cell, you need to use the Activate or Select method
- 18 Moving to Other Cells
- 19 Repeating Actions with a Loop
- 20 Select ActiveCell and cells to its Left
- 21 Select ActiveCell and cells to its Right
- 22 Select active cell and up to the end
- 23 Select ActiveCell"s range
- 24 Select Current Region
- 25 Select First To Last In Column
- 26 Select First To Last In Row
- 27 Store the location of the active cell and then return it to the stored location
- 28 Swap Text With Cell On Right
- 29 Take the current text value, and add the message "INVALID: " before the text
- 30 Toggles text wrap alignment for selected cells
- 31 Use ActiveCell.Offset to move the curren selection
- 32 Use ActiveCell.SpecialCells(xlLastCell)
- 33 Use all the ordinary numeric operators, like +, -, /, *, and ^.
- 34 Use Do Loop While to change ActiveCell value
- 35 Use if, ElseIf and Else with ActiveCell
- 36 Uses the EntireColumn property, which returns a Range object that consists of a full column:
- 37 Working with the Region around the Active Cell
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>