Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

数据透视表40+个常用小技巧,让你一次学会!
查看: 218|回复: 11

[已解决]请教:统计指定列、数、向下第几个的种类及个数

[复制链接]
发表于 2022-6-25 17:06 | 显示全部楼层 |阅读模式
本帖最后由 lygyjt 于 2022-6-25 17:15 编辑

请教老师:
“原始数据”表中:A列是序号列,不参与统计;其它列是数据列(最多10列,此时是9列)。

“统计”表中:B1、B2、B3是手动输入。在“原始数据”中找到B1列(B1=1,B列;B1=2,C列,以此类推),找到此列中所有B2所在的位置,每个位置向下移动B3个单元格。此时所有这些单元格形成了一个数组。对这个数组进行种类及对应个数的统计,将结果写在D:E下面。

比如:B1=1,B2=54,B3=10。在“原始数据”中的第1列,找出所有54这个数所在的位置,分别是:B(7、11、20、……195),一共22个有数据的单元格。这22个单元格都向下移动10个单元格,就形成了新21个有数据的单元格(因为原始数据总共200行,B195向下移动10个单元格,是空单元格了)。对新21个数据进行统计种类(相当于对21个数据去重),及每个种类在21个数据中存在几个(即,个数)。

具体例子: 统计指定列、数、向下第几个的种类及个数.rar (20.82 KB, 下载次数: 9)
发表于 2022-6-26 11:47 | 显示全部楼层


是這樣嗎? 請測試看看,謝謝

Sub test()
Dim Arr, xD, Brr(1 To 100000, 1 To 10)
Dim xC%, xN$, xR&, T$, n&, i&, i1&, j%
Set xD = CreateObject("Scripting.Dictionary")
With Sheets(2)
    xC = .[b1]: xN = .[b2]: xR = .[b3]
End With
Arr = Sheets(1).[a1].CurrentRegion
For i = 1 To UBound(Arr)
    T = Arr(i, xC + 1): If T <> xN Then GoTo 95
    n = n + 1: i1 = i
    For R = 1 To xR: For j = 1 To UBound(Arr, 2)
        If i + R - 1 > UBound(Arr) Then GoTo 95
        Brr(n + R - 1, j) = Arr(i + R - 1, j)
    Next: Next
    n = n + xR - 1
95: Next
For i = 1 To n: For j = 2 To 10
    xD(Brr(i, j) & "") = xD(Brr(i, j) & "") + 1
Next: Next
With Sheets(2)
    [d2:e1000] = ""
    .Range("d2:d" & xD.Count).NumberFormatLocal = "@"
    .[d2].Resize(xD.Count, 1) = Application.Transpose(xD.keys)
    With .Range("d2:e" & xD.Count + 1)
        Arr = .Value
        For i = 1 To UBound(Arr): Arr(i, 2) = xD(Arr(i, 1) & ""): Next
        .NumberFormatLocal = "@"
       .Value = Arr
    End With
End With
End Sub


回复

使用道具 举报

 楼主| 发表于 2022-6-26 12:15 | 显示全部楼层
sam-wang 发表于 2022-6-26 11:47
是這樣嗎? 請測試看看,謝謝

Sub test()

再次谢谢老师的指教啊!您辛苦啦!吃完午饭回来就测啊,呵呵
回复

使用道具 举报

发表于 2022-6-26 12:20 | 显示全部楼层
本帖最后由 sam-wang 于 2022-6-26 12:24 编辑
lygyjt 发表于 2022-6-26 12:15
再次谢谢老师的指教啊!您辛苦啦!吃完午饭回来就测啊,呵呵

#2是找到54後,則本身列~往後加9列數據
如下是找到54,則往後的第10列為數據
請測試看看,謝謝

Sub test()
Dim Arr, xD, Brr, xC%, xN$, xR&, T$, n&, i&, i1&, j%
Set xD = CreateObject("Scripting.Dictionary")
With Sheets(2)
    xC = .[b1]: xN = .[b2]: xR = .[b3]
End With
Arr = Sheets(1).[a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr)
    T = Arr(i, xC + 1): If T <> xN Then GoTo 95
    R = i + xR: If R > UBound(Arr) Then GoTo 95
    n = n + 1
    For j = 1 To UBound(Arr, 2): Brr(n, j) = Arr(R, j): Next
95: Next
For i = 1 To n: For j = 2 To 10
    xD(Brr(i, j) & "") = xD(Brr(i, j) & "") + 1
Next: Next
With Sheets(2)
    [d2:e1000] = ""
    .Range("d2:d" & xD.Count).NumberFormatLocal = "@"
    .[d2].Resize(xD.Count, 1) = Application.Transpose(xD.keys)
    With .Range("d2:e" & xD.Count + 1)
        Arr = .Value
        For i = 1 To UBound(Arr): Arr(i, 2) = xD(Arr(i, 1) & ""): Next
        .NumberFormatLocal = "@"
       .Value = Arr
    End With
End With
End Sub


回复

使用道具 举报

 楼主| 发表于 2022-6-26 15:24 | 显示全部楼层
sam-wang 发表于 2022-6-26 12:20
#2是找到54後,則本身列~往後加9列數據
如下是找到54,則往後的第10列為數據
請測試看看,謝謝

让老师受累啦!怪我没表达清晰。本意是只在指定列里面找,如像1楼那个例子:B1=1,就是在“原始数据”表中,数据列中的第1列,即,B列中查找。查找什么?查找54这个数(B2=54)。在原始数据的B列中,把所有54的位置找到。然后这些位置各自向下数10个单元格(B3=10。向下数的时候,不算自己本身),把这些“第10个单元格”中的数据,进行种类和对应个数的统计,将结果放到D:E列。

不知这回说清没有?我在线等老师,哪没说清的,及时回复您。
回复

使用道具 举报

发表于 2022-6-26 15:58 | 显示全部楼层
lygyjt 发表于 2022-6-26 15:24
让老师受累啦!怪我没表达清晰。本意是只在指定列里面找,如像1楼那个例子:B1=1,就是在“原始数据”表 ...

4樓的就是如您的需求了吧?如果不是請附上過成程的結果,這樣比較容易理解需求,謝謝

回复

使用道具 举报

 楼主| 发表于 2022-6-26 16:00 | 显示全部楼层
sam-wang 发表于 2022-6-26 15:58
4樓的就是如您的需求了吧?如果不是請附上過成程的結果,這樣比較容易理解需求,謝謝

老师,4楼不是我要的结果。1楼例子中的结果,是真实结果。
回复

使用道具 举报

发表于 2022-6-26 16:11 | 显示全部楼层
lygyjt 发表于 2022-6-26 16:00
老师,4楼不是我要的结果。1楼例子中的结果,是真实结果。

可以附上每個過程的結果,因為無法理解1樓的解果如何產生得到,謝謝
回复

使用道具 举报

 楼主| 发表于 2022-6-26 16:13 | 显示全部楼层
sam-wang 发表于 2022-6-26 16:11
可以附上每個過程的結果,因為無法理解1樓的解果如何產生得到,謝謝

好的,老师,马上按您说的办
回复

使用道具 举报

 楼主| 发表于 2022-6-26 16:48 | 显示全部楼层
sam-wang 发表于 2022-6-26 16:11
可以附上每個過程的結果,因為無法理解1樓的解果如何產生得到,謝謝

过程说明.rar (8.07 KB, 下载次数: 6)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2022-8-15 12:26 , Processed in 0.220659 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表