[已解决]求写个VBA

lmknj · 发表于 2012-1-17 14:19

Book2.rar (1.86 KB, 下载次数: 15)

lmknj · 发表于 2012-1-17 15:38

怎么这么安静,看来没希望啊?

sunjing-zxl · 发表于 2012-1-17 15:40

Sub aa()
Dim arr, arr1, i As Long, j As Long
Dim arr2, str(1 To 3) As String
arr = Range(Cells(4, 1), Cells(5, Range("A4").End(xlToRight).Column))
ReDim arr1(1 To 2, 1 To 3)
ReDim arr2(1 To 1, 1 To UBound(arr, 2))
For i = 1 To UBound(arr, 2)
For j = 1 To 3
arr1(1, j) = Mid(arr(1, i), j, 1)
arr1(2, j) = Mid(arr(2, i), j, 1)
Next j
If arr1(1, 2) = arr1(1, 1) Then
str(1) = IIf(arr1(1, 1) - arr1(2, 1) < 0, arr1(1, 1) - arr1(2, 1) + 10, arr1(1, 1) - arr1(2, 1))
str(2) = IIf(arr1(1, 2) - arr1(2, 2) < 0, arr1(1, 2) - arr1(2, 2) + 10, arr1(1, 2) - arr1(2, 2))
If arr1(1, 3) = arr1(1, 2) Then
str(3) = IIf(arr1(1, 3) - arr1(2, 3) < 0, arr1(1, 3) - arr1(2, 3) + 10, arr1(1, 3) - arr1(2, 3))
arr2(1, i) = str(1) & str(2) & str(3)
Else
arr2(1, i) = str(1) & str(2) & "*"
End If
ElseIf arr1(1, 3) = arr1(1, 1) Then
str(1) = IIf(arr1(1, 1) - arr1(2, 1) < 0, arr1(1, 1) - arr1(2, 1) + 10, arr1(1, 1) - arr1(2, 1))
str(3) = IIf(arr1(1, 3) - arr1(2, 3) < 0, arr1(1, 3) - arr1(2, 3) + 10, arr1(1, 3) - arr1(2, 3))
arr2(1, i) = str(1) & "*" & str(3)
ElseIf arr1(1, 3) = arr1(1, 2) Then
str(2) = IIf(arr1(1, 2) - arr1(2, 2) < 0, arr1(1, 2) - arr1(2, 2) + 10, arr1(1, 2) - arr1(2, 2))
str(3) = IIf(arr1(1, 3) - arr1(2, 3) < 0, arr1(1, 3) - arr1(2, 3) + 10, arr1(1, 3) - arr1(2, 3))
arr2(1, i) = "*" & str(2) & str(3)
End If
Next i
End Sub

复制代码

sunjing-zxl · 发表于 2012-1-17 15:41

附件：

Book2-sunjing.rar (10.27 KB, 下载次数: 6)

lmknj · 发表于 2012-1-17 15:52

sunjing-zxl 发表于 2012-1-17 15:41
附件：

点按钮为何没有反应,帮忙再看下

sunjing-zxl · 发表于 2012-1-17 15:54

你不换数据，最后结果和原来一样当然不可能有反应了

上清宫主 · 发表于 2012-1-17 15:58

大帅做了活路忘了给你结果了

lmknj · 发表于 2012-1-17 16:13

sunjing-zxl 发表于 2012-1-17 15:54
你不换数据，最后结果和原来一样当然不可能有反应了

换了数据还是没有结果,没有反应

sunjing-zxl · 发表于 2012-1-17 16:29

最后加一句：
Range("A6").Resize(1, UBound(arr2, 2)) = arr2

附件：

Book2-sunjing.rar (10.41 KB, 下载次数: 11)

lmknj · 发表于 2012-1-17 16:37

sunjing-zxl 发表于 2012-1-17 16:29
最后加一句：
Range("A6").Resize(1, UBound(arr2, 2)) = arr2

太谢谢你了,大师真了不起.

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