[已解决]提取相反边的数据

excelpxfans001

提取相反边的数据,麻烦老师看下哦。

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-10 20:38

excelpxfans001 发表于 2016-6-10 20:34
你好，还是有错误哦。

你自己在测试下

跳转到最佳答案楼层

老司机带带我

脑子有点转不过来，你自己测试下

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim arr(0 To 4), brr(0 To 4)
   
3.     If Target.Count > 1 Then Exit Sub
   
4.     If Target.Row < 7 Or Target.Row > 20 Then Exit Sub
   
5.     If Target.Column < 2 Or Target.Column > 18 Then Exit Sub
   
6.     If Target.Offset(-1, 0) = "" Then Exit Sub
   
7.     For i = 0 To 4
   
8.         If Target.Value + i > 9 Then
   
9.             arr(i) = Target.Value + i - 10
   
10.         Else
    
11.             arr(i) = Target.Value + i
    
12.         End If
    
13.         If Target.Value - i - 1 < 0 Then
    
14.             brr(i) = Target.Value - i + 9
    
15.         Else
    
16.             brr(i) = Target.Value - i - 1
    
17.         End If
    
18.     Next
    
19.     If Target.Offset(-1, 0).Value > Target.Value Then
    
20.         If Target.Offset(-1, 0).Value - Target.Value < 5 Then
    
21.             Sheet1.[ar1:ar5] = Application.WorksheetFunction.Transpose(arr)
    
22.             Sheet1.[aq1:aq5] = Application.WorksheetFunction.Transpose(brr)
    
23.         Else
    
24.             Sheet1.[ar1:ar5] = Application.WorksheetFunction.Transpose(brr)
    
25.             Sheet1.[aq1:aq5] = Application.WorksheetFunction.Transpose(arr)
    
26.         End If
    
27.     Else
    
28.         If Abs(Target.Offset(-1, 0).Value - Target.Value) < 5 Then
    
29.             Sheet1.[ar1:ar5] = Application.WorksheetFunction.Transpose(arr)
    
30.             Sheet1.[aq1:aq5] = Application.WorksheetFunction.Transpose(brr)
    
31.         Else
    
32.             Sheet1.[ar1:ar5] = Application.WorksheetFunction.Transpose(brr)
    
33.             Sheet1.[aq1:aq5] = Application.WorksheetFunction.Transpose(arr)
    
34.         End If
    
35.     End If
    
36. End Sub

复制代码

excelpxfans001

老司机带带我 发表于 2016-6-10 15:22
脑子有点转不过来，你自己测试下

你好老师，不要自动的，改成运行代码的如何改的。麻烦您再看下哦。

excelpxfans001

老司机带带我 发表于 2016-6-10 15:22
脑子有点转不过来，你自己测试下

麻烦老师看下哦。

老司机带带我

看附件

excelpxfans001

老司机带带我 发表于 2016-6-10 19:54
看附件

你好，还是有错误哦。

老司机带带我

excelpxfans001 发表于 2016-6-10 20:34
你好，还是有错误哦。

你自己在测试下

excelpxfans001

老司机带带我 发表于 2016-6-10 20:38
你自己在测试下

可以。只是结果未从小到大排列。 谢谢老师

excelpxfans001

老司机带带我 发表于 2016-6-10 20:38
你自己在测试下

你好。验证发现有一个情况有错误。估计是您说的6-1=5临界值造成的。麻烦老师看下。

老司机带带我

附件已更新