Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

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

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

[复制链接]
发表于 2022-6-22 10:52 | 显示全部楼层 |阅读模式
3学分
请教老师:

“原始数据”中,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, 下载次数: 4)

最佳答案

查看完整内容

請測試看看,謝謝 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 & "|" ...
发表于 2022-6-22 10:52 | 显示全部楼层    本楼为最佳答案   

請測試看看,謝謝

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


评分

参与人数 1学分 +2 收起 理由
lygyjt + 2 我和小伙伴都惊呆了

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2022-6-22 16:07 | 显示全部楼层
sam-wang 发表于 2022-6-22 10:52
請測試看看,謝謝

Sub test()

谢谢老师的指教!答案完美!
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2022-8-15 10:57 , Processed in 0.197680 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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