в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:31Z

1 версия

Новая страница

==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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Excel/ActiveCell - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия