[已解决]求出代表的数字

excelpxfans001

爱疯 发表于 2016-3-25 19:10
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim A(9), B(), i

你好老师！
1.选取的数字区域会有增加。
2.能否改成不自动的。即选取单元格，运行代码再求出数据。

dsmch

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. w = Split("2,3,5,8,9 ;2,3,5,7 ;2,3,5,8,9;1,3,4,6,8;2,3,5,6 ;0,3,4,8,9;3,4,6,7,8;4,5,6,7,8;5,6,7,8,9;5,6,7,8,9", ";")
   
3. [z1:z10] = ""
   
4. If Not Application.Intersect([g10].CurrentRegion, Target) Is Nothing And Target.Count = 1 Then
   
5.     If Target <> "" Then
   
6.         x = Split(w(Target.Value), ",")
   
7.         [z1].Resize(UBound(x) + 1) = Application.Transpose(x)
   
8.     End If
   
9. End If
   
10. End Sub

复制代码

excelpxfans001

dsmch 发表于 2016-3-25 20:59

你好老师，可否改成不自动的。选取单元格，运行代码，再求得结果。

爱疯

Sub test()
    Dim arr(), rng As Range
    Set rng = Selection
    [z1:z5].ClearContents
    If rng.Count = 1 Then
        If Len(rng) Then
            If rng >= 0 And rng <= 9 Then
                arr = [{2,2,2,1,2,0,3,4,5,5;3,3,3,3,3,3,4,5,6,6;5,5,5,4,5,4,6,6,7,7;8,7,8,6,6,8,7,7,8,8;9,"",9,8,"",9,8,8,9,9}]
                [z1:z5] = Application.Index(arr, 0, rng + 1)
            End If
        End If
    End If
End Sub


趣味3.rar (18.29 KB, 下载次数: 6)

2016-3-25 21:09 上传

点击文件名下载附件
这样吗？

excelpxfans001

爱疯 发表于 2016-3-25 21:09
Sub test()
    Dim arr(), rng As Range
    Set rng = Selection

好的，代码中的数字排是第一位，然后第二，第三，第四，第五，第六，第七，第八，第九这样排的对么？

爱疯

arr = [{2,2,2,1,2,0,3,4,5,5;3,3,3,3,3,3,4,5,6,6;5,5,5,4,5,4,6,6,7,7;8,7,8,6,6,8,7,7,8,8;9,"",9,8,"",9,8,8,9,9}]


红色，即Y8里的数据
蓝色，即Y9里的数据
...

excelpxfans001

爱疯 发表于 2016-3-25 21:41
arr = [{2,2,2,1,2,0,3,4,5,5;3,3,3,3,3,3,4,5,6,6;5,5,5,4,5,4,6,6,7,7;8,7,8,6,6,8,7,7,8,8;9,"",9,8,"", ...

好的，我试下。

爱疯

Sub test()
    Dim A(9), B(), rng As Range, i
    Set rng = Selection
    [z1:z5].ClearContents
    If rng.Count = 1 Then
        If Len(rng) Then
            If rng >= 0 And rng <= 9 Then

                A(0) = Array(2, 3, 5, 8, 9)
                A(1) = Array(2, 3, 5, 7)
                A(2) = Array(2, 3, 5, 8, 9)
                A(3) = Array(1, 3, 4, 6, 8)
                A(4) = Array(2, 3, 5, 6)
                A(5) = Array(0, 3, 4, 8, 9)
                A(6) = Array(3, 4, 6, 7, 8)
                A(7) = Array(4, 5, 6, 7, 8)
                A(8) = Array(5, 6, 7, 8, 9)
                A(9) = Array(5, 6, 7, 8, 9)

                B = A(rng)
                ReDim B(1 To UBound(B) + 1, 1 To 1)
                For i = 1 To UBound(B)
                    B(i, 1) = A(rng)(i - 1)
                Next i
                [z1].Resize(UBound(B)) = B

            End If
        End If
    End If
End Sub

趣味4.rar (19.26 KB, 下载次数: 6)

2016-3-25 21:59 上传

点击文件名下载附件


这种好查看一点，方便修改。