Excel实战技巧18：自动设置动态选取标记使用 Excel 2007及以上版本中提供的称

微信公众号：

excelperfect

引子：

本文为学习

excelhero.com

中的技巧文章《

Excel Dynamic Checkmark

》整理的学习笔记。

Daniel Ferry

总是以其精湛的

VBA

技术和创造力制作出令人惊叹的作品，真是值得好好研学，反复体味。因为每一次的学习，不仅会让你感受到

Excel

的强大和作者想像力的丰富，而且最重要的是能够提升你的技能。

图

看到了吗？当双击相关单元格时，单元格中的标记会循环变化。下面，我就来详细介绍一下实现这种技巧的方法。

图

所示的工作表名为“

list

”，在单元格区域

B5:C12

中的表的名称为“

BucketList

”，在单元格区域

E5:F12

中的表的名称为“

BucketListBasic

”，在单元格区域

H5:I12

中的表的名称为“

BucketListProgress

”。此外，将单元格

B15

命名为“

alpha_round_robin

”。

另外，还定义了下列名称。

名称：

checkmark_range

引用位置：

=list!$B$6:$B$12,list!$E$6:$E$12,list!$H$6:$H$12,alpha_round_robin

名称：

rr_0

引用位置：

={1,""}

名称：

rr_1

引用位置：

={1,0,""}

名称：

rr_2

引用位置：

={0,1,2,3,4}

名称：

rr_3

引用位置：

=TRANSPOSE(CHAR(ROW(list!$65:$90)))

很显然，名称

rr_3

生成的数字对应着大写字母的

ANSI

编码。

设置条件格式如下：

在单元格区域

B6:B12

中的条件格式规则如图

所示。

图

在单元格区域

E6:E12

中的条件格式规则如图

所示。

图

在单元格区域

H6:H12

中的条件格式规则如图

所示。

图

由于是双击单元格来循环显示图标，因此需要用到工作表事件

Worksheet_BeforeDoubleClick

：

Private SubWorksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

CellRoundRobin Target, [checkmark_range],[{"rr_1";"rr_0";"rr_2";"rr_3"}],Cancel, True

End Sub

积极的情绪，自信的孩子

作者：[美] 肯尼斯?巴里西（Kenneth Barish, Ph.D.）

当当

购买

事件中调用的子过程

CellRoundRobin

：

Public SubCellRoundRobin(rTarget As Range, _

rValidRange As Range,_

vRoudRobinQue AsVariant, _

Optional bCancel AsBoolean, _

OptionalbDisableDragandDrop As Boolean)

Dim i As Long, L As Long, U As Long

On Error Resume Next

单元格数超过

个

或者双击的单元格不在定义的区域内

退出程序

If rTarget.Cells.Count > 1 Then Exit Sub

If Intersect(rTarget, rValidRange) IsNothing Then Exit Sub

判断数组是否为二维数组

If GetArrayDimesions(vRoudRobinQue) = 2Then

在单元格区域块间循环

For i = 1 To rValidRange.Areas.Count

定位到相应的单元格区域

If Not Intersect(rTarget,rValidRange.Areas(i)) Is Nothing Then

将数组中的名称代表的数组赋值

vRoudRobinQue =Evaluate(vRoudRobinQue(i, 1))

Exit For

End If

获取数组的下限和上限

L = LBound(vRoudRobinQue)

U = UBound(vRoudRobinQue)

With Application

If bDisableDragandDrop Then.CellDragAndDrop = False

比较相应的值并获取索引

For i = L To U

If rTarget = vRoudRobinQue(i) AndLen(rTarget) = Len(vRoudRobinQue(i)) Then Exit For

i = i + 1

If i > U Then i = L

获取数组中对应的值

rTarget = vRoudRobinQue(i)

bCancel = True

End With

End Sub

判断数组的维数

Public FunctionGetArrayDimesions(vArray) As Long

Dim i As Long

On Error GoTo ErrorHandler

i = i + 1

Loop While UBound(vArray, i)

ErrorHandler:

GetArrayDimesions = i - 1

End Function

由于在程序中改变了拖拉单元格时的设置，因此在关闭工作簿前恢复该设置：

Private SubWorkbook_BeforeClose(Cancel As Boolean)

Application.CellDragAndDrop = True

End Sub

有兴趣的朋友可以在完美

Excel

微信公众号底部发送消息：

动态标记

下载示例工作簿。

也可以在

DanielFerry

的博客中下载：

http://www.excelhero.com/blog/2011/03/excel-dynamic-checkmark.html

欢迎分享本文，转载请注明出处。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。