[已解决]有请liuts 版主再给修改下代码

东方智彩 · 发表于 2012-2-8 22:21

本帖最后由东方智彩于 2012-2-9 10:23 编辑

新的问题是,数据运算后在C列还会出现2个或3个数字重复,能否在这个代码上再加个判断和循环，让C列中的数据如果有2个或3个数字重复的，就在C列再次如上运算，
例099→C列090，0重复再加1为091，C列中最终显示结果是091，
例343→C列344，4重复再加1为345，C列中最终显示结果是345，请版主再给修改下代码，谢谢！

Book1.rar (8.21 KB, 下载次数: 12)

东方智彩 · 发表于 2012-2-10 10:08

版主很忙不在啊!哪位高手能给修改下也行啊!谢谢啦!

爱疯 · 发表于 2012-2-10 10:29

只是看了链接帖里的要求，这个贴新加的要求没看懂。

如果要判断的数是199，按链接帖里的要求，应转为啥？

东方智彩 · 发表于 2012-2-10 11:28

199是两个重复数就在后面的数上加1,结果为190,如是999三个数重复,第二个重复数加1取尾为0,第三个数就要加2取尾是1,结果应为901

爱疯 · 发表于 2012-2-10 11:35

我没问对，那334应等于多少呀？

东方智彩 · 发表于 2012-2-10 11:47

就是这个问题,重复3加1是4就成了344了,再次出现重复,所以第二个重复数还要加1就是345

爱疯 · 发表于 2012-2-10 13:02

本帖最后由爱疯于 2012-2-10 13:25 编辑

Sub test()
Dim A, i%
With Sheets("sheet1")
A = .Range("b4:c" & .Range("b4").End(xlDown).Row)
End With
For i = 1 To UBound(A)
A(i, 2) = pd(A(i, 1))
Next i
[c4].Resize(UBound(A), 1) = Application.Index(A, 0, 2)
End Sub
Function pd(x) '判断
Dim b%, s%, g%
100:
pd = x
b = Left(x, 1)
s = Mid(x, 2, 1)
g = Right(x, 1)
'如果百位和十位相同 , 那么十位加1取尾
If b = s Then
x = b & Right((s + 1), 1) & g
GoTo 100
End If
'如果十位和个位相同 , 那么个位加1取尾
If s = g Then
x = b & s & Right((g + 1), 1)
GoTo 100
End If
'如果个位和百位相同 , 那么个位加1取尾
If g = b Then
x = b & s & Right((g + 1), 1)
GoTo 100
End If
'如3个数码全相同,第2位加1取尾,第3位加2取尾
If Replace(x, b, "", , 3) = "" Then
pd = b & Right((s + 1), 1) & Right((g + 2), 1)
End If
End Function

复制代码

Book1c.rar (19.62 KB, 下载次数: 12)

东方智彩 · 发表于 2012-2-10 13:35

谢谢爱疯版主热情解答,代码测试很好!

		自动登录	找回密码
密码			注册

[已解决]有请liuts 版主再给修改下代码

评分