VBA常用代码解析（第二讲）

　　011 单元格格式操作
　　011-1 单元格字体格式设置
　　在VBA中可以对单元格的字体格式进行各种设置，如下面的代码所示。
　　Public Sub RngFont()
　　WithRange(A1).Font
　　.Name = 华文彩云
　　.FontStyle = Bold
　　.Size = 18
　　.ColorIndex = 3
　　.Underline = 2
　　EndWith
　　End Sub
　　代码解析：
　　RngFont过程对单元格A1的字体格式进行设置。
　　其中第3行代码设置字体为“华文彩云”，应用于Font对象的Name属性返回或设置对象的名称。
　　第4行代码设置字体为加粗，FontStyle属性返回或设置字体样式。设置为“Bold”加粗字体，设置为“Italic”倾斜字体，也可以设置成“Bold Italic”。
　　第5行代码设置字体的大小为18磅，Size属性返回或设置字体大小。
　　第6行代码设置字体的颜色为红色，应用于Font对象的ColorIndex属性返回或设置字体的颜色，该颜色可指定为当前调色板中颜色的编号。
　　第7行代码设置字体为单下划线类型，Underline属性返回或设置应用于字体的下划线类型，可为表格所列的XlUnderlineStyle常量之一。
　　011-2 设置单元格内部格式
　　设置单元格的Interior属性可以对单元格的内部格式进行设置，如下面的代码所示。
　　Sub RngInterior()
　　WithRange(A1).Interior
　　.ColorIndex = 3
　　.Pattern = xlPatternCrissCross
　　.PatternColorIndex = 6
　　EndWith
　　End Sub
　　代码解析：
　　RngInterior过程对A1单元格的内部格式进行设置。
　　第2行代码使用Interior属性返回单元格对象的内部。
　　第3行代码设置单元格边框内部的颜色为红色。应用于Interior对象的ColorIndex属性返回或设置边框内部的颜色，可指定为如▲11-1所示的当前调色板中颜色的编号或为XlColorIndex 常量之一：xlColorIndexAutomatic(自动填充)、xlColorIndexNone (无内部填充)。
　　第4行代码设置单元格设置内部图案为十字图案。应用于Interior对象的Pattern属性返回或者设置内部图案。
　　第5行代码设置单元格设置内部图案的颜色为黄色。应用于Interior对象的PatternColorIndex属性返回或设置内部图案的颜色，可指定为如▲11-1中所示的当前调色板中颜色的编号或为XlColorIndex常量之一：xlColorIndexAutomatic (自动填充)、xlColorIndexNone (无内部填充)。
　　011-3 为单元格区域添加边框
　　我们为单元格区域添加边框时往往通过录制宏获取代码，但宏录制器生成的代码分别设置单元格区域的每个边框，因此代码多且效率低。使用Range对象的Borders集合可以快速的对单元格区域的每个边框应用相同的格式，而Range对象的BorderAround方法则可以快速地为单元格区域添加一个外边框，如下面的代码所示。
　　Sub AddBorders()
　　Dimrng As Range
　　Setrng = Range(B4:G10)
　　Withrng.Borders
　　.LineStyle = xlContinuous
　　.Weight = xlThin
　　.ColorIndex = 5
　　EndWith
　　rng.BorderAroundxlContinuous，xlMedium，5
　　Setrng = Nothing
　　End Sub
　　代码解析：
　　AddBorders过程为单元格区域B4:G10设置内部统一边框并添加一个加粗外边框。
　　第4行到第8行代码使用Borders属性引用单元格区域的Borders集合，其中第5行代码设置其边框样式线条的样式，第6行代码设置边框线条的粗细，第7行代码设置边框的颜色。
　　应用于Range对象的Borders集合代表Range对象的4个边框(左边框、右边框、顶部边框和底部边框)的4个Border对象组成的集合，这4个边框既可单独返回，也可作为一个组同时返回。
　　第9行代码使用BorderAround方法为单元格区域添加一个加粗外边框。
　　应用于Range对象的BorderAround方法向单元格区域添加整个区域的外边框，并设置该边框的相关属性，其语法如下：
　　BorderAround(LineStyle，Weight，ColorIndex，Color)
　　其中LineStyle参数设置边框线条的样式，Weight参数设置边框线条的粗细，ColorIndex参数设置边框颜色，Color参数以RGB值指定边框的颜色。
　　注意指定Color参数可以设置颜色为当前调色板之处的其它颜色，不能同时指定ColorIndex参数和Color参数。
　　运行AddBorders过程，效果。
　　如果需要在单元格区域中应用多种边框格式，则需分别设置各边框格式，如下面的代码所示。
　　Sub BordersDemo()
　　Dimrng As Range
　　Setrng = Sheet2.Range(B4:G10)
　　Withrng.Borders(xlInsideHorizontal)
　　.LineStyle = xlDot
　　.Weight = xlThin
　　.ColorIndex = 5
　　EndWith
　　Withrng.Borders(xlInsideVertical)
　　.LineStyle = xlContinuous
　　.Weight = xlThin
　　.ColorIndex = 5
　　EndWith
　　rng.BorderAroundxlContinuous，xlMedium，5
　　Setrng = Nothing
　　End Sub
　　代码解析：
　　BordersDemo过程代码为单元格区域内部边框在水平和垂直方向上应用不同格式，并为区域添加一个加粗外边框。
　　Borders(index)属性返回单个Border对象，其Index参数取值可为表格所列的XlBordersIndex常量之一：
　　011-4 灵活设置单元格的行高列宽
　　一般情况下单元格的行高列宽都是以磅为单位进行设置的，也可以使用英寸和厘米计量单位设置单元格的行高列宽，如下面的代码所示。
　　Sub RngToPoints()
　　WithRange(A1)
　　.RowHeight = Application.CentimetersToPoints(2)
　　.ColumnWidth = Application.CentimetersToPoints(1.5)
　　EndWith
　　WithRange(A2)
　　.RowHeight = Application.InchesToPoints(1.2)
　　.ColumnWidth = Application.InchesToPoints(0.3)
　　EndWith
　　End Sub
　　代码解析：
　　RngToPoints过程以英寸和厘米计量单位设置单元格的行高列宽。
　　第3、4行代码使用CentimetersToPoints方法以厘米为计量单位设置A1单元格的行高列宽。CentimetersToPoints方法将计量单位从厘米转换为磅(一磅等于0.035 厘米)，语法如下：
　　expression.CentimetersToPoints(Centimeters)
　　参数expression是必需的，返回一个Application对象。
　　参数Centimeters是必需的，指定要转换为磅值的厘米值。
　　第5、6行代码使用InchesToPoints方法以英寸为计量单位设置B2单元格的行高列宽。InchesToPoints方法将计量单位从英寸转换为磅，语法如下：
　　expression.InchesToPoints(Inches)
　　参数expression是必需的，返回一个Application对象。
　　参数Inches是必需的，指定要转换为磅值的英寸值。
　　▲012 单元格中的数据有效性
　　012-1 在单元格中建立数据有效性
　　在单元格中建立数据有效性可以使用Add方法，如下面的代码所示。
　　Sub Validation()
　　WithRange(A1:A10).Validation
　　.Delete
　　.Add Type:=xlValidateList，_
　　AlertStyle:=xlValidAlertStop，_
　　Operator:=xlBetween，_
　　Formula1:=1，2，3，4，5，6，7，8
　　EndWith
　　End Sub
　　代码解析：
　　Validation过程使用Add方法在A1：A10单元格中建立数据有效性。
　　第3行代码删除已建立的数据有效性，防止代码运行出错。
　　第4行到第7行代码使用Add方法建立数据有效性。应用于Validation对象的Add方法的语法如下：
　　expression.Add(Type，AlertStyle，Operator，Formula1，Formula2)
　　参数expression是必需的，返回一个Validation对象。
　　参数Type是必需的，数据有效性类型。
　　参数AlertStyl是可选的，有效性检验警告样式。
　　参数Operator是可选的，数据有效性运算符。
　　参数Formula1是可选的，数据有效性公式的第一部分。
　　参数Formula2是可选的，当Operator为xlBetween或xlNotBetween时，数据有效性公式的第二部分(其他情况下，此参数被忽略)。
　　Add 方法所要求的参数依有效性检验的类型而定，如表格所示。
　　012-2 判断单元格是否存在数据有效性
　　在VBA中没有专门的属性判断单元格是否存在数据有效性设置，可以使用Validation对象的有效性类型和错误陷阱来判断，如下面的代码所示。
　　Sub Validation()
　　On ErrorGoTo Line
　　If Range(A2).Validation.Type= 0 Then
　　MsgBox 单元格有数据有效性!
　　Exit Sub
　　EndIf
　　Line:
　　MsgBox单元格没有数据有效性!
　　End Sub
　　代码解析：
　　Validation过程使用Validation对象的有效性类型和错误陷阱来判断A2单元格中是否存在数据有效性。
　　第6行代码，如果A2单元格中存在数据有效性，Type参数值就会大于等于0，否则就会发生错误，使用OnError GoTo捕捉到错误后转移到第8行代码，显示一个消息框。
　　012-3 动态的数据有效性
　　利用VBA可以在单元格中建立动态的数据有效性，如下面的代码所示。
　　Private Sub Worksheet_SelectionChange(ByVal TargetAs Range)
　　If Target.Column= 1 And Target.Count = 1 And Target.Row  1 Then
　　With Target.Validation
　　.Delete
　　.Add Type:=xlValidateList，_
　　AlertStyle:=xlValidAlertStop，_
　　Operator:=xlBetween，_
　　Formula1:=主机，显示器
　　End With
　　EndIf
　　End Sub
　　Private Sub Worksheet_Change(ByVal Target As Range)
　　If Target.Column= 1 And Target.Row  1 And Target.Count = 1 Then
　　With Target.Offset(0，1).Validation
　　.Delete
　　Select Case Target
　　Case 主机
　　.Add Type:=xlValidateList，_
　　AlertStyle:=xlValidAlertStop，_
　　Operator:=xlBetween，_
　　Formula1:=Z286，Z386，Z486，Z586
　　Case 显示器
　　.Add Type:=xlValidateList，_
　　AlertStyle:=xlValidAlertStop，_
　　Operator:=xlBetween，_
　　Formula1:=三星17，飞利浦15，三星15，飞利浦17
　　End Select
　　End With
　　EndIf
　　End Sub
　　代码解析：
　　第1行到第11行代码，工作表的SelectionChange事件，当选择工作表的A列单元格时，在A2以下的单元格中建立动态的数据有效性。
　　其中第2行代码，利用SelectionChange事件的Target参数来限制事件的触发条件。
　　第3行到第9行代码使用Add方法在A列单元格中建立数据有效性。应用于Validation对象的Add方法请参阅▲12-1。
　　第12行到第30行代码，工作表的Change事件，当工作表A列单元格内容改变时，在B列单元格中建立动态的数据有效性。
　　其中第16行到第27行代码，根据A列单元格的内容在B列对应的单元格中建立数据有效性，其Formula1参数的值根据A列单元格的内容而变化，使之达到动态数据有效性的效果。
　　012-4 自动展开数据有效性下拉列表
　　选择工作表单元格时自动展开数据有效性的下拉列表，如下面的代码所示。
　　Private Sub Worksheet_SelectionChange(ByVal TargetAs Range)
　　If Target.Column= 5 Then Application.SendKeys %{down}
　　End Sub
　　代码解析：
　　当选择工作表的E列中有数据有效性的单元格时使用SendKeys方法发送Alt+向下键，打开数据有效性的下拉列表。
　　应用于Application对象的SendKeys方法将击键发送给活动应用程序，语法如下：
　　expression.SendKeys(Keys，Wait)
　　参数expression是可选的，该表达式返回一个Application对象。
　　参数Keys是必需的，要发送的键或者组合键，以文本方式表示。
　　Keys参数可以指定任何单个键或与Alt、Ctrl 或Shift的组合键(或者这些键的组合)。每个键可用一个或多个字符表示。例如，a 表示字符 a，或者 {ENTER} 表示 Enter。
　　若要指定在按相应键时不会显示的字符(例如，Enter 或Tab)，请使用如表格所列的代码来表示相应的键，表中的每个代码表示键盘上的一个键。
　　当选择工作表中的E列单元格时将自动展开数据有效性的下拉列表，
　　▲13 单元格中的公式
　　013-1 在单元格中写入公式
　　使用Range对象的Formula属性可以在单元格区域中写入公式，如下面的代码所示。
　　Sub rngFormula()
　　Sheet1.Range(C1:C10).Formula= =SUM(A1+B1)
　　End Sub
　　代码解析：
　　应用于Range对象的Formula属性返回或设置A1样式表示的Range对象的公式，语法如下：
　　expression.Formula
　　参数expression是必需的，返回一个Range对象。
　　还可以使用FormulaR1C1属性返回或设置以R1C1-样式符号表示的公式，如下面的代码所示。
　　Sub rngFormulaRC()
　　Sheet2.Range(C1:C10).FormulaR1C1 = =SUM(RC[-2]+RC[-1])
　　End Sub如果需要在单元格中写入数组公式则使用Range对象的FormulaArray属性。如下面的代码所示。
　　Sub RngFormulaArray()
　　Sheet3.Range(C1).FormulaArray= =A1:A2*B1:B2
　　End SubRange对象的FormulaArray属性返回或设置单元格区域的数组公式。
　　013-2 检查单元格是否含有公式
　　使用单元格的HasFormula属性检查单元格是否含有公式，如下面的代码所示。
　　Private Sub CommandButton1_Click()
　　SelectCase Selection.HasFormula
　　Case True
　　MsgBox 公式单元格!
　　Case False
　　MsgBox 非公式单元格!
　　Case Else
　　MsgBox 公式区域：  Selection.SpecialCells(xlCellTypeFormulas，23).Address(0，0)
　　EndSelect
　　End Sub
　　代码解析：
　　工作表中按钮的单击过程，检查所选择的单元格区域是否含有公式。
　　第2行代码返回所选择单元格区域的HasFormula属性值。如果区域中所有单元格均包含公式，则该值为True；如果所有单元格均不包含公式，则该值为False。
　　第3、4行代码，如果返回True，说明区域中所有单元格均包含公式。
　　第5、6行代码，如果返回False，说明区域中所有单元格均不包含公式。
　　第7、8行代码，如果是混合区域，则显示包含公式的单元格地址。
　　013-3 判断单元格公式是否存在错误
　　当需要获取的单元格的值由公式返回时，公式返回的结果可能是一个错误文本，包含#NULL!、#DIV/0!、#VALUE!、#REF!、#NAME?、#NUM!、#N/A等。此时，当单元格公式返回结果为错误文本时，如果试图通过Value属性来获得公式的返回结果，将得到类型不匹配的错误信息。
　　通过Range对象的Value属性的返回结果是否为错误类型，来判断公式是否存在错误，如下面的代码所示。
　　Sub FormulaIsError()
　　If VBA.IsError(Range(A1).Value)= True Then
　　MsgBox A1单元格错误类型为:  Range(A1).Text
　　Else
　　MsgBox A1单元格公式结果为  Range(A1).Value
　　EndIf
　　End Sub
　　代码解析：
　　FormulaIsError过程代码判断单元格A1中公式结果是否为错误，如果为错误则显示该错误类型，否则显示公式的结果。
　　第2行代码使用IsError函数返回Boolean值，指出表达式是否为一个错误值，如果表达式表示一个错误，则IsError函数返回True，否则返回False。
　　013-4 取得单元格中公式的引用单元格
　　如果需要取得单元格中公式的引用单元格对象，可以使用Range对象的Precedents属性，如下面的代码所示。
　　Sub RngPrecedent()
　　Dimrng As Range
　　Setrng = Sheet1.Range(C1).Precedents
　　MsgBox公式所引用的单元格有：  rng.Address
　　Setrng = Nothing
　　End Sub
　　代码解析：
　　在工作表的C1单元格中写有公式“SUM(“A1:B1”)”，RngPrecedent过程使用Range对象的Precedents属性取得其引用的单元格A1:B1。
　　Precedents属性返回一个Range对象，该对象代表单元格的所有引用单元格。如果有若干引用单元格，那么该区域可能是多个的选定区域(Range 对象的联合)。
　　013-5 将单元格中的公式转换为数值
　　工作表中如果存在过多的公式将影响操作速度，将单元格中的函数与公式的结果转换为数值，可以提高工作表运算效率，有下面几种方法可以实现。
　　使用选择性粘贴的方法可以将函数与公式的结果转换为数值，如下面的代码所示。
　　Sub SpecialPaste()
　　WithRange(A1:A10)
　　.Copy
　　.PasteSpecial Paste:=xlPasteValues
　　EndWith
　　Application.CutCopyMode= False
　　End Sub
　　代码解析：
　　SpecialPaste过程使用选择性粘贴方法将单元格区域的公式转换为数值。
　　第3行代码将单元格区域复制到剪贴板中。
　　应用于Range对象的Copy方法将单元格区域复制到指定的区域或剪贴板中，语法如下：
　　expression.Copy(Destination)参数expression是必需的，该表达式返回一个Range对象。
　　参数Destination是可选的，指定区域要复制到的目标区域。如果省略该参数，Microsoft Excel 将把该区域复制到剪贴板中。
　　第4行代码将剪贴板中的Range对象仅复制值到单元格区域中。
　　应用于Range对象的PasteSpecial方法将剪贴板中的Range对象粘贴到指定区域中，语法如下：
　　expression.PasteSpecial(Paste，Operation，SkipBlanks，Transpose)
　　参数expression是必需的，该表达式返回一个Range对象。
　　参数Paste是可选的，指定要粘贴的区域部分。在本例中设置为xlPasteValues，仅复制值到单元格区域中。使用Value属性可以将函数与公式的结果转换为数值，如下面的代码所示。
　　Sub UseValue()
　　Range(A1:A10).Value= Range(A1:A10).Value
　　End Sub
　　代码解析：
　　UseValue过程使用Value属性将函数与公式的结果转换为数值。使用Formula属性可以将函数与公式的结果转换为数值，如下面的代码所示。
　　Sub UseFormula()
　　Range(A1).Formula= Range(A1).Value
　　End Sub
　　代码解析：
　　UseFormula过程Formula属性将函数与公式的结果转换为数值。当Formula属性值为非公式时，返回的结果与Value属性一致。
　　▲14 单元格中的批注
　　014-1 判断单元格是否存在批注
　　在VBA中，可以利用Range对象的Comment属性判断单元格是否存在批注，如下面的代码所示。
　　Sub HasComment()
　　If Range(A1).CommentIs Nothing Then
　　MsgBox A1单元格中没有批注!
　　Else
　　MsgBox A1单元格中批注内容为：  Chr(13)  Range(A1).Comment.Text
　　EndIf
　　End Sub
　　代码解析：
　　HasComment过程判断A1单元格是否存在批注，并用消息框显示批注信息。
　　Range对象的Comment属性返回一个批注对象，如果指定的单元格不存在批注，该属性返回Nothing。
　　运行HasComment过程结果。
　　014-2 为单元格添加批注
　　如果希望为单元格添加批注，那么可以使用AddComment方法，如下面的代码所示。
　　Sub Comment_Add()
　　WithRange(A1)
　　If .Comment Is Nothing Then
　　.AddComment Text:=.Value
　　.Comment.Visible = True
　　End If
　　EndWith
　　End Sub
　　代码解析：
　　Comment_Add判断单元格A1中是否存在批注，如果没有批注则为单元格A1添加批注并将单元格数值作为批注文本，同时显示批注对象。
　　第4行代码使用Range对象的AddComment方法为单元格添加批注。该方法只有一个参数Text，代表批注文本。如果单元格已经存在批注，则该方法返回一个错误。
　　第5行代码显示批注对象，Visible属性确定对象是否可视。
　　当单元格A1中不存在批注时，运行代码后的结果。
　　014-3 删除单元格中的批注
　　如果需要删除单元格中的批注，那么可以使用ClearComments方法、ClearNotes方法或者Delete方法，如下面的代码所示。
　　Sub Commentdel()
　　On ErrorResume Next
　　Range(A1).ClearComments
　　Range(A2).ClearNotes
　　Range(A3).Comment.Delete
　　End Sub格中的批注。
　　第2行代码错误处理语句，如果单元格中没有批注，那么运行第5行代码时会发生错误，所以使用On Error语句来忽略错误。
　　第3行代码使用ClearComments方法删除单元格A1中的批注。ClearComments方法清除指定区域的所有单元格批注，语法如下：
　　expression.ClearComments
　　第4行代码使用ClearNotes方法删除A2单元格中的批注。ClearNotes方法清除指定区域中所有单元格的附注和语音批注，语法如下：
　　expression.ClearNotes
　　第5行代码使用Delete方法删除删除A3单元格中的批注.Range对象的Comment属性返回一个Comment对象，该对象代表与该区域左上角单元格相关联的批注。
　　▲15 合并单元格操作
　　015-1 判断单元格区域是否存在合并单元格
　　Range对象的MergeCells属性可以确定单元格区域是否包含合并单元格，如果该属性返回值为True，则表示区域包含合并单元格。
　　下面的代码判断单元格 A1是否包含合并单元格，并显示相应的提示信息。
　　Sub IsMergeCell()
　　If Range(A1).MergeCells= True Then
　　MsgBox 包含合并单元格
　　Else
　　MsgBox 没有包含合并单元格
　　EndIf
　　End Sub
　　如果在指定区域中存在部分合并的单元格，比如工作表区域E8:I17中包含合并单元格区域F8:G9，H12:I13。
　　判断这样一个单元格区域中是否包含合并单元格，可以使用下面的代码快速判断单元格区域中是否包含部分合并单元格，而不需要遍历单元格。
　　Sub IsMerge()
　　If IsNull(Range(E8:I17).MergeCells)Then
　　MsgBox 包含合并单元格
　　Else
　　MsgBox 没有包含合并单元格
　　EndIf
　　End Sub
　　代码解析：
　　当单元格区域中同时包含合并单元格和非合并单元格时，MergeCells属性将返回Null，因此第2行代码通过该返回结果作为判断条件。
　　015-2 合并单元格时连接每个单元格的文本
　　使用Excel的“合并及居中”按钮合并多个单元格区域时，Excel仅保留区域左上角单元格的内容，如果用户希望在合并单元格区域时，将各个单元格的内容连接起来保存在合并后的单元格区域中，则可以使用下面的代码。
　　Sub Mergerng()
　　DimStrMerge As String
　　Dimrng As Range
　　If TypeName(Selection)= Range Then
　　For Each rng In Selection
　　StrMerge = StrMerge  rng.Value
　　Next
　　Application.DisplayAlerts = False
　　Selection.Merge
　　Selection.Value = StrMerge
　　Application.DisplayAlerts = True
　　EndIf
　　End Sub
　　代码解析：
　　Mergerng过程将所选各个单元格的内容连接起来保存在合并后的单元格区域中。
　　第4行代码使用TypeName函数判断当前选定对象是否为Range对象，若是则继续执行代码。
　　第5行到第7行代码将当前选中区域的内容连接起来保存在字符串变量StrMerge中。
　　第8行代码将DisplayAlerts属性设置为False，禁止在合并多重数值区域时，Excel显示的警告信息，避免中断代码的运行。
　　第9行代码使用Merge方法合并当前选定区域。应用于Range对象的Merge方法通过指定Range对象创建合并单元格，语法如下：
　　expression.Merge(Across)
　　参数expression是必需的，返回一个Range对象。
　　参数Across是可选的，如果该值为True，则将指定区域内的每一行合并为一个合并单元格。默认值为False。
　　第9行也可以使用下面的代码：
　　Selection.MergeCells= True
　　第10行代码将变量StrMerge的值赋给合并后的单元格。
　　015-3 合并内容相同的连续单元格
　　如果需要合并工作表中B列中部门相同的连续单元格，可以使用下面的代码。
　　Sub Mergerng()
　　DimIntRow As Integer
　　Dimi As Integer
　　Application.DisplayAlerts= False
　　WithSheet1
　　IntRow = .Range(A65536).End(xlUp).Row
　　For i = IntRow To 2 Step -1
　　If .Cells(i，2).Value = .Cells(i - 1，2).Value Then
　　.Range(.Cells(i - 1，2)，.Cells(i，2)).Merge
　　End If
　　Next
　　EndWith
　　Application.DisplayAlerts= True
　　End Sub
　　代码解析：
　　第7行到第11行代码，从最后一行开始，向上逐个单元格判断连续两个单元格的内容是否相同，如果相同则合并。
　　015-4 取消合并单元格时在每个单元格中保留内容
　　如果需要取消▲15-3中工作表B列“部门”的合并单元格，并且各个单元格均保留原合并单元格的内容，可以使用下面的代码。
　　Sub UnMerge()
　　DimStrMer As String
　　DimIntCot As Integer
　　Dimi As Integer
　　WithSheet1
　　For i = 2 To .Range(B65536).End(xlUp).Row
　　StrMer = .Cells(i，2).Value
　　IntCot = .Cells(i，2).MergeArea.Count
　　.Cells(i，2).UnMerge
　　.Range(.Cells(i，2)，.Cells(i + IntCot - 1，2)).Value = StrMer
　　i = i + IntCot - 1
　　Next
　　EndWith
　　End Sub
　　代码解析：
　　UnMerge过程取消工作表中B列中的合并单元格，并且各个单元格均保留原合并单元格的内容。
　　第7行代码取得B列每个合并单元格的内容。
　　第8行代码取得合并区域的单元格数量。
　　第9行代码使用UnMerge方法取消合并单元格。UnMerge方法将合并区域分解为独立的单元格，语法如下：
　　expression.UnMerge
　　第10行代码将原合并单元格的内容赋值给取消合并单元格后的区域。
　　第11行代码调整循环变量i的值，使下一次循环从下一个单元格区域开始。