[已解决]【请教】2个数据间的统计

xdwy81129

感谢解答，6个BB表示顺了

最佳答案

月排行榜 / 总排行榜

amulee

2010-3-23 15:47

看看行不，运行Main

Sub Main()
    Call 统计("B", 2, 3)
    Call 统计("B", 3, 4)
End Sub
Sub 统计(strB As String, intN, ColN As Integer)
    Dim i&, j&, k&, Temp
    Dim arrYS, arrRec
    arrYS = Sheet1.Range("B1:B" & Sheet1.Range("B65536").End(xlUp).Row)
    ReDim arrRec(1 To 2, 1 To 1)
    '遍历原始数组并记录
    For i = 1 To UBound(arrYS)
        If arrYS(i, 1) = strB Then
            k = k + 1
            arrRec(1, 1) = i
            Exit For
        End If
    Next i
    For i = i + 1 To UBound(arrYS)
        If arrYS(i, 1) = intN Then Temp = Temp + 1
        If arrYS(i, 1) = strB Then
            k = k + 1
            ReDim Preserve arrRec(1 To 2, 1 To k)
            arrRec(1, k) = i
            arrRec(2, k - 1) = Temp
            Temp = 0
        End If
    Next i
    '结果输出
    Temp = UBound(arrRec, 2)
    Sheet1.Range(Cells(2, ColN), Cells(Sheet1.Range("B65536").End(xlUp).Row, ColN)).ClearContents
    Sheet1.Cells(arrRec(1, 1), ColN) = Val(arrRec(2, 1))
    Sheet1.Cells(arrRec(1, Temp), ColN) = Val(arrRec(2, Temp - 1))
    For i = 2 To UBound(arrRec, 2) - 1
        If (arrRec(1, i) - arrRec(1, i - 1)) > (arrRec(1, i + 1) - arrRec(1, i)) Then
            Temp = arrRec(2, i)
        Else
            Temp = arrRec(2, i - 1)
        End If
        Cells(arrRec(1, i), ColN) = Temp
    Next i
End Sub

跳转到最佳答案楼层

xdwy81129

顶顶。希望老师帮助解答。

另外，不需要for循环，因为for循环很慢

老申

？？？？？

爱疯

不明白题意。

。。。。要不，楼主给个手工输出结果的图样？

 

[em09]

上清宫主

不用for 用do？可能是想用find吧？用find还是要用循环的哟。

其实用for+数组，不慢。

amulee

看看行不，运行Main

Sub Main()
    Call 统计("B", 2, 3)
    Call 统计("B", 3, 4)
End Sub
Sub 统计(strB As String, intN, ColN As Integer)
    Dim i&, j&, k&, Temp
    Dim arrYS, arrRec
    arrYS = Sheet1.Range("B1:B" & Sheet1.Range("B65536").End(xlUp).Row)
    ReDim arrRec(1 To 2, 1 To 1)
    '遍历原始数组并记录
    For i = 1 To UBound(arrYS)
        If arrYS(i, 1) = strB Then
            k = k + 1
            arrRec(1, 1) = i
            Exit For
        End If
    Next i
    For i = i + 1 To UBound(arrYS)
        If arrYS(i, 1) = intN Then Temp = Temp + 1
        If arrYS(i, 1) = strB Then
            k = k + 1
            ReDim Preserve arrRec(1 To 2, 1 To k)
            arrRec(1, k) = i
            arrRec(2, k - 1) = Temp
            Temp = 0
        End If
    Next i
    '结果输出
    Temp = UBound(arrRec, 2)
    Sheet1.Range(Cells(2, ColN), Cells(Sheet1.Range("B65536").End(xlUp).Row, ColN)).ClearContents
    Sheet1.Cells(arrRec(1, 1), ColN) = Val(arrRec(2, 1))
    Sheet1.Cells(arrRec(1, Temp), ColN) = Val(arrRec(2, Temp - 1))
    For i = 2 To UBound(arrRec, 2) - 1
        If (arrRec(1, i) - arrRec(1, i - 1)) > (arrRec(1, i + 1) - arrRec(1, i)) Then
            Temp = arrRec(2, i)
        Else
            Temp = arrRec(2, i - 1)
        End If
        Cells(arrRec(1, i), ColN) = Temp
    Next i
End Sub

xdwy81129

QUOTE:

以下是引用amulee在2010-3-23 15:47:00的发言：

看看行不，运行Main

Sub Main()
    Call 统计("B", 2, 3)
    Call 统计("B", 3, 4)
End
  Sub
Sub 统计(strB As
  String, intN, ColN As
  Integer)
    Dim i&, j&, k&, Temp
    Dim arrYS, arrRec
    arrYS = Sheet1.Range("B1:B" & Sheet1.Range("B65536").End(xlUp).Row)
    ReDim arrRec(1 To 2, 1 To 1)
    '遍历原始数组并记录
    For i = 1 To
  UBound(arrYS)
        If arrYS(i, 1) = strB Then
            k = k + 1
            arrRec(1, 1) = i
            Exit
  For
        End
  If
    Next i
    For i = i + 1 To
  UBound(arrYS)
        If arrYS(i, 1) = intN Then Temp = Temp + 1
        If arrYS(i, 1) = strB Then
            k = k + 1
            ReDim
  Preserve arrRec(1 To 2, 1 To k)
            arrRec(1, k) = i
            arrRec(2, k - 1) = Temp
            Temp = 0
        End
  If
    Next i
    '结果输出
    Temp = UBound(arrRec, 2)
    Sheet1.Range(Cells(2, ColN), Cells(Sheet1.Range("B65536").End(xlUp).Row, ColN)).ClearContents
    Sheet1.Cells(arrRec(1, 1), ColN) = Val(arrRec(2, 1))
    Sheet1.Cells(arrRec(1, Temp), ColN) = Val(arrRec(2, Temp - 1))
    For i = 2 To
  UBound(arrRec, 2) - 1
        If (arrRec(1, i) - arrRec(1, i - 1)) > (arrRec(1, i + 1) - arrRec(1, i)) Then
            Temp = arrRec(2, i)
        Else
            Temp = arrRec(2, i - 1)
        End
  If
        Cells(arrRec(1, i), ColN) = Temp
    Next i
End
  Sub

非常非常的感谢阿木老师的精心赐教。
但有几个问题仍然求教阿木老师帮助解答下。

1.答案请求输入为在c列的第8行依次得到答案（统计之间多少个2）

2   老师的答案中， Call 统计(""B"", 2, 3)和Call 统计(""B"", 3, 4)

这里的""B""，表示什么意思？？

后面的2，3或者是3，4表示什么意思。

3.如果就本题而言，我不是计算B字母之间有多少个2，而是计算D字母之间有多少个2应该怎么改动宏。

再次希望得到老师的解答。期盼！

xdwy81129

QUOTE:

以下是引用xdwy81129在2010-3-24 0:10:00的发言：

非常非常的感谢阿木老师的精心赐教。
但有几个问题仍然求教阿木老师帮助解答下。

1.答案请求输入为在c列的第8行依次得到答案（统计之间多少个2）

2   老师的答案中， Call 统计(""B"", 2, 3)和Call 统计(""B"", 3, 4)

这里的""B""，表示什么意思？？

后面的2，3或者是3，4表示什么意思。

3.如果就本题而言，我不是计算B字母之间有多少个2，而是计算D字母之间有多少个2应该怎么改动宏。

再次希望得到老师的解答。期盼！

请老师帮忙再指教下

xdwy81129

盼盼！！！！

xdwy81129

再顶下，希望完美解决