VBA编程练习05. 在工作表中实现七段显示
学习Excel技术，关注微信公众号：
excelperfect
本次练习题
这是一个有趣的VBA编程练习，来自于dailydoseofexcel.com。使用VBA代码在工作表中将数字显示为七段显示，如下图1所示。
图1
在单元格C9中输入四位及四位以内的数字，在单元格区域B2:P6中会像电子显示屏一样以七段形式显示这个数字。
VBA代码
代码如下：
Public Sub ShowSevenSegment(ByVal lInput As Long)
'声明变量
Dim sValue As String
Dim i As Long, j As Long
Dim aDigits(0 To 9) As Variant
Dim aRange() As String
Dim aRow(0 To 6) As Long, aCol(0 To 6) As Long
Dim rSeg As Range
'声明常量,指定显示的数位和颜色
Const lDISPCNT As Long = 4
Const lON As Long = vbBlack
Const lOFF As Long = vbWhite
'存储每个显示数左上角单元格
ReDim aRange(1 To lDISPCNT)
'每个数字设置每段的开/关.
'顺序是上/左上/右上/中/左下/右下/下
aDigits(0) = Array(lON, lON, lON, lOFF,lON, lON, lON)
aDigits(1) = Array(lOFF, lOFF, lON, lOFF,lOFF, lON, lOFF)
aDigits(2) = Array(lON, lOFF, lON, lON,lON, lOFF, lON)
aDigits(3) = Array(lON, lOFF, lON, lON,lOFF, lON, lON)
aDigits(4) = Array(lOFF, lON, lON, lON,lOFF, lON, lOFF)
aDigits(5) = Array(lON, lON, lOFF, lON,lOFF, lON, lON)
aDigits(6) = Array(lON, lON, lOFF, lON,lON, lON, lON)
aDigits(7) = Array(lON, lOFF, lON, lOFF,lOFF, lON, lOFF)
aDigits(8) = Array(lON, lON, lON, lON, lON,lON, lON)
aDigits(9) = Array(lON, lON, lON, lON,lOFF, lON, lON)
'设置每一段与左上角单元格的偏离
aRow(0) = 0: aCol(0) = 1
aRow(1) = 1: aCol(1) = 0
aRow(2) = 1: aCol(2) = 2
aRow(3) = 2: aCol(3) = 1
aRow(4) = 3: aCol(4) = 0
aRow(5) = 3: aCol(5) = 2
aRow(6) = 4: aCol(6) = 1
'设置每个显示数左上解单元格
For i = 1 To lDISPCNT
aRange(i) =Sheet1.Range("B2").Offset(0, (i - 1) * 4).Address
Next i
'根据需要截取和填充值
If lInput > (10 ^ lDISPCNT) - 1 Then
sValue = Left$(lInput, lDISPCNT)
Else
sValue = Format(lInput,String(lDISPCNT, "0"))
End If
'清理
Sheet1.Range(aRange(1)).Resize(5,15).Interior.Color = lOFF
'遍历数字
For i = 1 To Len(sValue)
'对数字遍历开/关
For j =LBound(aDigits(CLng(Mid$(sValue, i, 1)))) To UBound(aDigits(CLng(Mid$(sValue,i, 1))))
'获取相应单元格并设置颜色
Set rSeg =Sheet1.Range(aRange(i)).Offset(aRow(j), aCol(j))
rSeg.Interior.Color =aDigits(CLng(Mid$(sValue, i, 1)))(j)
'设置四个角的颜色
If aDigits(CLng(Mid$(sValue, i,1)))(j) = lON Then
'对于水平段,填充左和右
If rSeg.Width > rSeg.Height Then
rSeg.Offset(0,-1).Interior.Color = lON
rSeg.Offset(0,1).Interior.Color = lON
Else
'对于垂直段,填充上和下
rSeg.Offset(-1,0).Interior.Color = lON
rSeg.Offset(1,0).Interior.Color = lON
End If
End If
Next j
Next i
End Sub
在数字所在的工作表模块中，输入下面的代码：
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address =Me.Range("C9").Address Then
ShowSevenSegment Target.Value2
End If
End Sub
下面是代码的图片版：
建议有兴趣的朋友多调试理解这段代码，帮助理解数组的运用、以及单元格的获取、偏移、设置等VBA操控Excel的基础知识。