第1章 Range单元格对象超实用VBA文档格式.docx

第1章 Range单元格对象超实用VBA文档格式.docx

《第1章 Range单元格对象超实用VBA文档格式.docx》由会员分享，可在线阅读，更多相关《第1章 Range单元格对象超实用VBA文档格式.docx（16页珍藏版）》请在冰豆网上搜索。

）.Offset（2,2）.Select

1-5使用Resize属性返回调整后的单元格区域

SubRngResize（）

）.Resize（4,4）.Select

范例2选定单元格区域的方法

2-1使用Select方法

SubRngSelect（）

Sheet2"

）.Activate

B10"

2-2使用Activate方法

SubRngActivate（）

2-3使用Goto方法

SubRngGoto（）

Application.GotoReference:

=Sheets（"

A1：

）,Scroll:

=True

范例3获得指定行的最后一个非空单元格

SubLastCell（）

DimrngAsRange

Setrng=Cells（Rows.Count,1）.End（xlUp）

MsgBox"

A列的最后一个非空单元格是"

&

rng.Address（0,0）_

"

行号"

rng.Row&

数值"

rng.Value

Setrng=Nothing

范例4使用SpecialCells方法定位单元格

SubSpecialAddress（）

Setrng=Sheet1.UsedRange.SpecialCells（xlCellTypeFormulas）

rng.Select

工作表中有公式的单元格为：

rng.Address

范例5查找特定内容的单元格

5-1使用Find方法查找特定信息

SubFindCell（）

DimStrFindAsString

StrFind=InputBox（"

请输入要查找的值：

"

）

IfLen（Trim（StrFind））>

0Then

WithSheet1.Range（"

A:

A"

Setrng=.Find（What:

=StrFind,_

After:

=.Cells（.Cells.Count）,_

LookIn:

=xlValues,_

LookAt:

=xlWhole,_

SearchOrder:

=xlByRows,_

SearchDirection:

=xlNext,_

MatchCase:

=False）

IfNotrngIsNothingThen

Application.Gotorng,True

Else

没有找到匹配单元格!

EndIf

EndWith

SubFindNextCell（）

DimFindAddressAsString

.Interior.ColorIndex=0

FindAddress=rng.Address

Do

rng.Interior.ColorIndex=6

Setrng=.FindNext（rng）

LoopWhileNotrngIsNothing_

Andrng.Address<

>

FindAddress

5-2使用Like运算符进行模式匹配查找

SubRngLike（）

DimrAsInteger

r=1

Sheet1.Range（"

）.ClearContents

ForEachrngInSheet2.Range（"

A40"

Ifrng.TextLike"

*a*"

Then

Cells（r,1）=rng.Text

r=r+1

范例6替换单元格内字符串

SubReplacement（）

）.Replace_

What:

="

市"

Replacement:

区"

_

=xlPart,SearchOrder:

范例7单元格的复制

7-1复制单元格区域

SubRangeCopy（）

G7"

）.CopySheet2.Range（"

SubCopyalltheforms（）

DimiAsInteger

）.Copy

WithSheet3.Range（"

.PasteSpecialxlPasteAll

.PasteSpecialxlPasteColumnWidths

Application.CutCopyMode=False

Fori=1To7

Sheet3.Rows（i）.RowHeight=Sheet1.Rows（i）.RowHeight

7-2仅复制数值到另一区域

SubCopyValue（）

Sheet2.Range（"

）.PasteSpecialPaste:

=xlPasteValues

SubGetValueResize（）

）.CurrentRegion

Sheet3.Range（"

）.Resize（.Rows.Count,.Columns.Count）.Value=.Value

范例8禁用单元格拖放功能

PrivateSubWorksheet_SelectionChange（ByValTargetAsRange）

IfTarget.Column=1Then

Application.CellDragAndDrop=False

Application.CellDragAndDrop=True

PrivateSubWorksheet_Deactivate（）

范例9设置单元格格式

9-1设置单元格字体格式

SubCellFont（）

WithRange（"

）.Font

.Name="

华文彩云"

.FontStyle="

Bold"

.Size=22

.ColorIndex=3

.Underline=2

9-2设置单元格内部格式

SubCellInternalFormat（）

）.Interior

.Pattern=xlPatternGrid

.PatternColorIndex=6

9-3单元格区域添加边框

SubCellBorder（）

Setrng=Range（"

B2:

Withrng.Borders（xlInsideHorizontal）

.LineStyle=xlDot

.Weight=xlThin

.ColorIndex=xlColorIndexAutomatic

Withrng.Borders（xlInsideVertical）

.LineStyle=xlContinuous

rng.BorderAroundxlContinuous,xlMedium,xlColorIndexAutomatic

SubQuickBorder（）

B12:

E18"

）.Borders.LineStyle=xlContinuous

范例10单元格的数据有效性

10-1添加数据有效性

SubAddValidation（）

A10"

）.Validation

.Delete

.AddType:

=xlValidateList,_

AlertStyle:

=xlValidAlertStop,_

Operator:

=xlBetween,_

Formula1:

1,2,3,4,5,6,7,8"

.ErrorMessage="

只能输入1-8的数值,请重新输入!

10-2判断是否存在数据有效性

SubErrValidation（）

OnErrorGoToLine

IfRange（"

）.Validation.Type>

=0Then

有数据有效性!

ExitSub

Line:

没有数据有效性!

10-3动态的数据有效性

IfTarget.Column=1AndTarget.Count=1AndTarget.Row>

1Then

WithTarget.Validation

主机,显示器"

PrivateSubWorksheet_Change（ByValTargetAsRange）

IfTarget.Column=1AndTarget.Row>

1AndTarget.Count=1Then

WithTarget.Offset（0,1）.Validation

SelectCaseTarget

Case"

主机"

Z286,Z386,Z486,Z586"

显示器"

15,17,21,25"

EndSelect

范例11单元格中的公式

11-1在单元格中写入公式

SubrngFormula（）

r=Cells（Rows.Count,1）.End（xlUp）.Row

C2"

=A2*B2"

）.CopyRange（"

C3:

C"

r）

r+1）="

合计"

r+1）.Formula="

=SUM（C2:

r&

）"

SubrngFormulaRC（）

C2:

r）.FormulaR1C1="

=RC[-2]*RC[-1]"

r+1）.FormulaR1C1="

=SUM（R[-"

r-1&

]C:

R[-1]C）"

SubRngFormulaArray（）

r+1）.FormulaArray="

]C[-2]:

R[-1]C[-2]*R[-"

]C[-1]:

R[-1]C[-1]）"

11-2判断单元格是否包含公式

SubrngIsHasFormula（）

SelectCaseSelection.HasFormula

CaseTrue

单元格包含公式!

CaseFalse

单元格没有公式!

CaseElse

公式区域：

Selection.SpecialCells（-4123,23）.Address（0,0）

11-3判断单元格公式是否存在错误

SubCellFormulaIsWrong（）

IfIsError（Range（"

）.Value）=TrueThen

A1单元格错误类型为:

）.Text

A1单元格公式结果为"

）.Value

11-4取得公式的引用单元格

SubRngPrecedent（）

Setrng=Sheet1.Range（"

C10"

）.Precedents

公式所引用的单元格是：

11-5将公式转换为数值

SubSpecialPaste（）

.Copy

.PasteSpecialPaste:

范例12单元格添加批注

SubAddComment（）

IfNot.CommentIsNothingThen.Comment.Delete

.AddCommentText:

=Date&

vbCrLf&

.Text

.Comment.Visible=True

范例13合并单元格操作

13-1判断单元格区域是否存在合并单元格

SubIsMergeCell（）

）.MergeCellsThen

合并单元格"

vbInformation

非合并单元格"

SubIsMergeCells（）

IfIsNull（Range（"

D10"

）.MergeCells）Then

包含合并单元格"

没有包含合并单元格"

13-2合并单元格时连接每个单元格的文本

SubMergeCells（）

DimMergeStrAsString

DimMergeRngAsRange

SetMergeRng=Range（"

ForEachrngInMergeRng

MergeStr=MergeStr&

rng&

Application.DisplayAlerts=False

MergeRng.Merge

MergeRng.Value=MergeStr

Application.DisplayAlerts=True

SetMergeRng=Nothing

13-3合并内容相同的连续单元格

SubMergeLinkedCell（）

WithSheet1

r=.Cells（Rows.Count,1）.End（xlUp）.Row

Fori=rTo2Step-1

If.Cells（i,2）.Value=.Cells（i-1,2）.ValueThen

.Range（.Cells（i-1,2）,.Cells（i,2））.Merge

13-4取消合并单元格时在每个单元格中保留内容

SubCancelMergeCells（）

DimMergeCotAsInteger

r=.Cells（.Rows.Count,1）.End（xlUp）.Row

Fori=2Tor

MergeStr=.Cells（i,2）.Value

MergeCot=.Cells（i,2）.MergeArea.Count

.Cells（i,2）.UnMerge

.Range（.Cells（i,2）,.Cells（i+MergeCot-1,2））.Value=MergeStr

i=i+MergeCot-1

.Range（"

B1:

B"

r）.Borders.LineStyle=xlContinuous

范例14高亮显示选定单元格区域

Cells.Interior.ColorIndex=xlColorIndexNone

Target.Interior.ColorIndex=Int（56*Rnd（）+1）

Setrng=Application.Union（Target.EntireColumn,Target.EntireRow）

rng.Interior.ColorIndex=Int（56*Rnd（）+1）

范例15双击被保护单元格时不显示提示消息框

PrivateSubWorksheet_BeforeDoubleClick（ByValTargetAsRange,CancelAs