Function Checksum(IMEI) 
On Error Resume Next 
Table = Array(Array(0, 8, 6, 4, 2, 9, 7, 5, 3, 1), Array(0, 9, 8, 7, 6, 5, 4, 3, 2, 1)) 
'建立一个二维数组
'相当于 Dim Table(1,9)  
'Table(0,0)=0
'Table(0,1)=8
'Table(0,2)=6
'......
'Table(1,8)=2
'Table(1,9)=1

Position = 1 

For I = 1 To 14 
  Checksum = Checksum + Table(Position)(Mid(IMEI, I, 1)) '按照你给定的IMEI的值的第一位至第14位，分别读出数组的数据并累积相加
  
  If Position = 1 Then                                   '当现在读取数组中第1维的数据，再一次就读取第2维的数据。循环读取
     Position = 0 
  Else 
     Position = 1 
  End If
  
Next I 
''''下面一段是取得计算后的总和的个位数值。
'可以用下面的句话代替
'Checksum = Checksum Mod 10

Do While Checksum >= 10 
Checksum = Checksum - 10 
Loop 
End Function