|
楼主 |
发表于 2018-6-18 08:22
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
尊敬的蓝桥玄霜版主:代码已测试,完全实现了我心中所想!如果我要改变数据源和结果显示列,以及指定截止行号的C2单元格,是不是只需要修改下面红色标注的3个地方就行了?Sub 冷码()
Dim brr(), sr()
tms = Timer
m = [c2].Value - 4
ar = [a5].Resize(m)
ReDim sr(1 To m, 1 To 1)
ReDim brr(0 To 2)
For i = 1 To m
t = ar(i, 1): t1 = Left(t, 1)
brr(t1) = brr(t1) + 1: If brr(t1) = 1 Then k1 = k1 + 1
If k1 = 2 Then k1 = i: Exit For
Next
s1 = 3 - Left(ar(1, 1), 1) - Left(ar(k1, 1), 1)
ReDim brr(0 To 2)
For i = 1 To m
t = ar(i, 1): t2 = Right(t, 1)
brr(t2) = brr(t2) + 1: If brr(t2) = 1 Then k2 = k2 + 1
If k2 = 2 Then k2 = i: Exit For
Next
s2 = 3 - Right(ar(1, 1), 1) - Right(ar(k2, 1), 1)
s = s1 & s2
If k1 > k2 Then k0 = k1 Else k0 = k2
For i = k0 To m
If ar(i - 1, 1) <> "" Then t = ar(i - 1, 1): t11 = Left(t, 1): t12 = Right(t, 1)
If ar(i, 1) <> "" Then
t = ar(i, 1): t21 = Left(t, 1): t22 = Right(t, 1)
If t11 = t21 Then s1 = Left(s, 1) Else s1 = 3 - Val(t11) - Val(t21)
If t12 = t22 Then s2 = Right(s, 1) Else s2 = 3 - Val(t12) - Val(t22)
s = s1 & s2
sr(i, 1) = s
End If
Next
[b5].Resize(m) = sr
MsgBox Format(Timer - tms, "0.000s")
End Sub
|
|