[已解决]请教：查找符合行之间的距离

lygyjt · 发表于 2022-6-22 10:52

请教老师：

“原始数据”中，A列是序号列，其它列是数据列（最多10列）。在“查找”表第1~10列标题行的下面，选择任意多处输入数据。在“原始数据”中，将与输入位置完全相同的行找出来，进行相邻序号差值的计算，并对差值进行种类及个数统计。
比如：在“第1列、第3列”下面分别输入1、58。在“原始数据”中，把某行（不包括序号）第1个数是1，并且第3个数是58这样的行全部找出来，它们的序号是：5、64、71、98。然后求这4个相邻序号的差值：64-5=59，71-64=7，98-71=27。得到的3个差值是：59、7、27。3个差值的种类（即，对3个差值去重后的数据）是：59、7、27，共3个数值。把这3个数值放在“种类”标题的下面。在3个差值中：59有1个，7有1个，27有1个，把1、1、1，写在“个数”标题对应种类的后面。

具体例子：

查找符合行之间的距离.rar (41.86 KB, 下载次数: 5)

sam-wang · 发表于 2022-6-22 10:52

这个最佳答案由 sam-wang 给出，感谢 sam-wang 的回答。

单击隐藏图章

請測試看看，謝謝

Sub test()
Dim Arr, xD, Brr(1 To 1000, 1 To 2), T, n%, s%, i&, j%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Sheets(2).[a1].CurrentRegion
For j = 1 To UBound(Arr, 2)
If Arr(3, j) = "" Then GoTo 95
xD(j & "|" & Arr(3, j)) = ""
95: Next
Arr = Sheets(1).[a1].CurrentRegion
For i = 1 To UBound(Arr)
For j = 2 To UBound(Arr, 2)
      T = j - 1 & "|" & Arr(i, j)
      If xD.Exists(T) Then n = n + 1
Next
If n = xD.Count Then
      s = s + 1: Brr(s, 1) = Arr(i, 1)
End If
n = 0
Next
xD.RemoveAll
For i = 1 To s
If i < s Then
      T = Brr(i + 1, 1) - Brr(i, 1)
      If xD.Exists(T) Then
         Brr(xD(T), 2) = Brr(xD(T), 2) + 1
      Else
         n = n + 1: xD(T) = n
         Brr(n, 1) = T: Brr(n, 2) = 1
      End If
End If
Next
Sheets(2).[L2].Resize(n, 2) = Brr
End Sub

lygyjt · 发表于 2022-6-22 16:07

sam-wang 发表于 2022-6-22 10:52
請測試看看，謝謝

Sub test()

谢谢老师的指教！答案完美！

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

[已解决]请教：查找符合行之间的距离

最佳答案

评分