[已解决]一个判断的VBA程序！

wszbd

新建 Microsoft Excel 工作表.rar (1.98 KB, 下载次数: 13)

2013-10-29 01:25 上传

点击文件名下载附件 如果我写的不清楚，就加qq：1091342689.

最佳答案

月排行榜 / 总排行榜

yyyydddd8888

2013-10-29 13:47

wszbd 发表于 2013-10-29 13:37
老师好：
           这个程序还有点小毛病，如果A1中是123  132，那么就有小错误。
   老师可否给修改 ...

是否想要这样？
新建 Microsoft Excel 工作表.zip (7.88 KB, 下载次数: 16)

2013-10-29 13:47 上传

点击文件名下载附件

跳转到最佳答案楼层

CheryBTL

1. Sub ep()
   
2.     Dim m As Integer, temp As Integer
   
3.     Dim i As Integer
   
4.     m = Sheets(1).Range("A1").Value
   
5.     For i = 1 To 3
   
6.         temp = Abs(Mid(m, i, 1) - i) * 10 ^ (3 - i) + temp
   
7.     Next i
   
8.     Sheets(1).Range("C1") = temp
   
9. End Sub
   

复制代码

yyyydddd8888

请测试
新建 Microsoft Excel 工作表.rar (7.45 KB, 下载次数: 6)

2013-10-29 08:42 上传

点击文件名下载附件

1. Sub 判断()
   
2. Dim i%, j%, k%, m%, temp$, arr(1 To 3), brr(1 To 3), crr(1 To 3)
   
3. For i = 1 To 3
   
4.     arr(i) = Mid(Range("a1"), i, 1)
   
5.     brr(i) = Mid(Range("a1"), i, 1)
   
6. Next i
   
7. 
   
8. For m = 1 To 2
   
9.     For j = m + 1 To 3
   
10.         If arr(m) > arr(j) Then
    
11.            temp = arr(m)
    
12.            arr(m) = arr(j)
    
13.            arr(j) = temp
    
14.         End If
    
15.     Next j
    
16. Next m
    
17. 
    
18. 
    
19. If Val(arr(1) + 1) = Val(arr(2)) And Val(arr(2) + 1) = Val(arr(3)) Then
    
20.         crr(1) = Abs(brr(1) - 1)
    
21.         crr(2) = Abs(brr(2) - 2)
    
22.         crr(3) = Abs(brr(3) - 3)
    
23.         Range("c1") = Val(Join(crr))
    
24. Else
    
25.         Range("c1") = Range("a1")
    
26. End If
    
27.    
    
28.      
    
29. End Sub
    

复制代码

sliang28

1. Sub sliang28()
   
2.     Dim arr(0 To 2)
   
3.     mynub = Range("A1")
   
4.     For i = 1 To 3
   
5.         arr(i - 1) = Val(Mid(mynub, i, 1))
   
6.     Next
   
7.     If Application.Max(arr) - Application.Large(arr, 2) = 1 And Application.Large(arr, 2) - Application.Min(arr) = 1 Then
   
8.         For i = 1 To 3
   
9.            result = result & Abs(Mid(mynub, i, 1) - i)
   
10.         Next
    
11.     End If
    
12.     [c1] = result
    
13. End Sub
    

复制代码

这样的话容易理解,应该不会有错了

wszbd

yyyydddd8888 发表于 2013-10-29 08:41
请测试

老师好：
           这个程序还有点小毛病，如果A1中是123  132，那么就有小错误。
   老师可否给修改一下。
谢谢！！！

yyyydddd8888

wszbd 发表于 2013-10-29 13:37
老师好：
           这个程序还有点小毛病，如果A1中是123  132，那么就有小错误。
   老师可否给修改 ...

是否想要这样？
新建 Microsoft Excel 工作表.zip (7.88 KB, 下载次数: 16)

2013-10-29 13:47 上传

点击文件名下载附件

wszbd

yyyydddd8888 发表于 2013-10-29 13:47
是否想要这样？

谢谢！！！

wszbd

sliang28 发表于 2013-10-29 09:23
这样的话容易理解,应该不会有错了

结果有点错误。
是两个如果。
问题解决了，谢谢你老师！！！

wszbd

CheryBTL 发表于 2013-10-29 07:59

结果有点错误。
是两个如果。
问题解决了，谢谢你老师！！！

wszbd

sliang28 发表于 2013-10-29 09:23
这样的话容易理解,应该不会有错了

如果A1不是连续的自然数，那么C1里没有返回