[已解决]求选取单元格的左右段数字

excelpxfans001

求选取单元格的左右段数字，见附件。

最佳答案

月排行榜 / 总排行榜

grf1973

2016-6-6 15:59

。。。。。

跳转到最佳答案楼层

grf1973

点中数据区域，会自动更新结果。

excelpxfans001

grf1973 发表于 2016-6-6 15:35
点中数据区域，会自动更新结果。

你好老师，谢谢！
1.不用自动的。用选取单元格后，运行代码的方式。
2.提取的结果是针对选取的那个单元格数字的左右，不是上一个数字的左右。

grf1973

。。。。。

pengyx

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Value <> "" And Target.Offset(-1, 0) <> "" Then
    Range("ao1") = Target.Address
    ReDim ar(0 To 9, 1 To 2)
    ReDim br(1 To 5, 1 To 1)
    t = 0
    For i = 0 To 4
        sb = (i + Target.Offset(-1, 0).Value) Mod 10
        br(i + 1, 1) = sb
        sa2 = (i + Target.Value) Mod 10
        ar(sa2, 2) = sa2
        sa1 = (Target.Value + 9 - i) Mod 10
        ar(sa1, 1) = sa1
        If sb = Target.Value Then t = 1
    Next
    If t = 1 Then
        s = -1: n = -1
        For j = 0 To 9
            If ar(j, 1) <> "" Then s = s + 1: ar(s, 1) = ar(j, 1)
            If ar(j, 2) <> "" Then n = n + 1: ar(n, 2) = ar(j, 2)
        Next
        Range("aq1").Resize(5, 2) = ar
    End If
End If
End Sub
试试这个哈

excelpxfans001

grf1973 发表于 2016-6-6 15:59
。。。。。

非常感谢老师的解答。

如果只单求任选取单元格的右边数据。是不是代码会简单些。

雪舞子

测试一下

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count = 1 Then
   
3.         If Application.IsNumber(Target) And Application.IsNumber(Target(0, 1)) Then
   
4.             s = "012345678901234567"
   
5.             s0 = Mid(s, InStr(s, Target(0, 1)), 5)
   
6.             If InStr(s0, Target) Then x = 44: y = 43 Else x = 43: y = 44
   
7.             
   
8.             For i = 1 To 5
   
9.                 Cells(i, x) = Mid(Mid(s, InStr(s, Target), 5), i, 1)
   
10.                 Cells(i, y) = Mid(Mid(s, InStr(6, s, Target) - 5, 5), i, 1)
    
11.             Next
    
12.         End If
    
13.    
    
14.     End If
    
15. End Sub
    

复制代码

提取左右段数据.rar (16.7 KB, 下载次数: 5)

2016-6-6 16:18 上传

点击文件名下载附件

excelpxfans001

雪舞子 发表于 2016-6-6 16:18
测试一下

对的，谢谢老师。但不要自动的，选取单元格，然后运行代码。