[已解决]excel 计算不同时出现数间隔及次数

demon558

666.rar (2.87 KB, 下载次数: 4)

2013-6-2 15:37 上传

点击文件名下载附件

例

4	3	7	6	8
2	4	9	1	6
2	10	7	3	11
3	8	7	5	4
3	8	9	2	5
3	11	2	1	9
10	9	3	2	11
4	6	11	9	10
3	2	7	9	11
3	1	11	9	2
3	7	1	4	2
5	4	7	3	11
2	9	3	5	1
6	2	5	9	8
10	6	11	1	7
1	5	7	4	10
11	1	5	10	9
9	4	10	1	11
3	6	9	7	4
6	2	10	9	11
7	6	1	4	10
2	9	6	10	8
8	7	3	4	1
11	1	7	5	8
10	5	3	4	7

求同时不出1，2、2.3.。。等数组的间隔次数

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2013-6-2 22:17

附件请测试，不出现次数显示在SHEET2里面

跳转到最佳答案楼层

wp8680

意思表达我看不明白，最好有示意结果。

demon558

拿1，2来说
第一。四。八，十二，十九，二十五行没出1或2，计6次
其他的以此类推

demon558

Private Sub CommandButton1_Click()

Dim no(2): Dim ro()
    With Sheets("统计")
    Const SD = 490
        rng1 = .Range("A2:E" & SD)
    End With
    With Sheets("间隔")
        i = 166
        rng2 = .Range("A2:C" & i)
    End With
    ReDim arr(1 To (i - 1), 1 To 4)
    For x = 1 To UBound(rng2)
        k = 0
        For y = 1 To SD - 1
            no(0) = 0: no(1) = 0: no(2) = 0
            For z = 1 To 5
                If rng1(y, z) = rng2(x, 1) Then no(0) = no(0) + 1
                If rng1(y, z) = rng2(x, 2) Then no(1) = no(1) + 1
                If rng1(y, z) = rng2(x, 3) Then no(2) = no(2) + 1
            Next
            If no(0) >= 1 And no(1) >= 1 And no(2) >= 1 Then
                ReDim Preserve ro(k)
                ro(k) = y
                k = k + 1
            End If
        Next
        ReDim Preserve ro(k)
        ro(k) = SD
        ReDim roh(k)
        ma = 0
        s = 0
        m = 0
       ' Stop
        For j = 0 To k
            If j + 1 > k Then Exit For
            roh(j) = ro(j + 1) - ro(j)
            s = s + roh(j)
            m = m + 1
            If ma < roh(j) Then
                ma = roh(j)
            End If
        Next
        arr(x, 1) = roh(k - 1)
        arr(x, 2) = ma
        arr(x, 3) = s / m
        arr(x, 4) = m

    Next
    With Sheets("间隔")
        .Range("d2:g" & i) = arr
    End With
End Sub

这是同时出现的代码，我要的是相反的效果，计算不出现的

大灰狼1976

附件请测试，不出现次数显示在SHEET2里面

demon558

大灰狼1976 发表于 2013-6-2 22:17
附件请测试，不出现次数显示在SHEET2里面

我原来的代码能不能修改呢？因为我还要改四码，五码的组合

demon558

大灰狼1976 发表于 2013-6-2 22:17
附件请测试，不出现次数显示在SHEET2里面

这是我改的，有的计算结果会正确，有的就是不正确，帮忙看看
Dim no(2): Dim ro()
    With Sheets("统计")
    Const SD = 490
        rng1 = .Range("A2:E" & SD)
    End With
    With Sheets("sheet1")
        i = 166
        rng2 = .Range("b2:d" & i)
    End With
    ReDim arr(1 To (i - 1), 1 To 4)
    For x = 1 To UBound(rng2)
        k = 0
        For y = 1 To SD - 1
            no(0) = 0: no(1) = 0: no(2) = 0
            For z = 1 To 5 - 1
                If rng1(y, z) = rng2(x, 1) Then no(0) = no(0) + 1
                If rng1(y, z) = rng2(x, 2) Then no(1) = no(1) + 1
                If rng1(y, z) = rng2(x, 3) Then no(2) = no(2) + 1
            Next
            If no(0) = 0 And no(1) = 0 And no(2) = 0 Then
                ReDim Preserve ro(k)
                ro(k) = y
                k = k + 1
            End If
        Next
        ReDim Preserve ro(k)
        ro(k) = SD
        ReDim roh(k)
        ma = 0
        s = 0
        m = 0
       ' Stop
        For j = 0 To k
            If j + 1 > k Then Exit For
            roh(j) = ro(j + 1) - ro(j)
            s = s + roh(j)
            m = m + 1
            If ma < roh(j) Then
                ma = roh(j)
            End If
        Next
        arr(x, 1) = roh(k - 1)
        arr(x, 2) = ma
        arr(x, 3) = s / m
        arr(x, 4) = m

    Next
    With Sheets("sheet1")
        .Range("e2:h" & i) = arr
    End With

大灰狼1976

看别人的代码并且要理解，特别是比较长的情况下，会比较累，我有时间的话看一下吧，话说改我的代码比较快，要4、5码组合还是其它都可以，只要加入循环

demon558

sheet2.rar (214.25 KB, 下载次数: 16)

2013-6-3 10:07 上传

点击文件名下载附件

你给看看吧，数据在“统计”a2:E,组合在sheet2里

大灰狼1976

SHEET2的格式是固定的吗，固定和不固定方法不一样，如果不固定，需要提供规律。