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

lygyjt · 发表于 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)

sam-wang · 发表于 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

lygyjt · 发表于 2022-6-26 12:15

sam-wang 发表于 2022-6-26 11:47
是這樣嗎? 請測試看看，謝謝

Sub test()

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

sam-wang · 发表于 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

lygyjt · 发表于 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列。

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

sam-wang · 发表于 2022-6-26 15:58

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

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

lygyjt · 发表于 2022-6-26 16:00

sam-wang 发表于 2022-6-26 15:58
4樓的就是如您的需求了吧？如果不是請附上過成程的結果，這樣比較容易理解需求，謝謝

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

sam-wang · 发表于 2022-6-26 16:11

lygyjt 发表于 2022-6-26 16:00
老师，4楼不是我要的结果。1楼例子中的结果，是真实结果。

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

lygyjt · 发表于 2022-6-26 16:13

sam-wang 发表于 2022-6-26 16:11
可以附上每個過程的結果，因為無法理解1樓的解果如何產生得到，謝謝

好的，老师，马上按您说的办

lygyjt · 发表于 2022-6-26 16:48

sam-wang 发表于 2022-6-26 16:11
可以附上每個過程的結果，因為無法理解1樓的解果如何產生得到，謝謝

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

		自动登录	找回密码
密码			注册