如何取同列中与关键字同名的行号?

无关岁月

做个辅助列，想怎么查都可以

xuerfu

无关岁月 发表于 2024-2-4 16:31
做个辅助列，想怎么查都可以

不是我要的方式，但还是谢谢您！

liulang0808

Sub 取同列中与关键字同名的行号()
   
    Dim d, Arr, Brr, i, k
   
    Set d = CreateObject("Scripting.Dictionary")
        
        Arr = Range("a1").CurrentRegion
        
        For i = 2 To UBound(Arr)
            If Not d.exists(Arr(i, 1)) Then
                Set d(Arr(i, 1)) = CreateObject("Scripting.Dictionary")
            End If
            d(Arr(i, 1))(d(Arr(i, 1)).Count) = Arr(i, 2)
            
        Next

        k1 = d("张三")(0)
        k2 = d("张三")(1)
         
    Set d = Nothing
   
End Sub

liulang0808

取同列中与关键字同名的行号.zip (12.35 KB, 下载次数: 11)

2024-2-4 19:14 上传

点击文件名下载附件

佛山小老鼠

1. Option Explicit
   
2. Sub test()
   
3.     Dim Dic, arr1, x, arr2, arr3, arr4(1 To 10000, 1 To 3)
   
4.     Set Dic = CreateObject("Scripting.Dictionary")
   
5.     arr1 = Range("A1").CurrentRegion
   
6.     For x = 2 To UBound(arr1)
   
7.         If Not Dic.exists(arr1(x, 1)) Then
   
8.            Dic(arr1(x, 1)) = arr1(x, 2)
   
9.         Else
   
10.           Dic(arr1(x, 1)) = Dic(arr1(x, 1)) & "," & arr1(x, 2)
    
11.         End If
    
12.     Next x
    
13.     arr3 = Dic.keys
    
14.     arr2 = Dic.items
    
15.     For x = 1 To Dic.Count
    
16.         arr4(x, 1) = arr3(x - 1)
    
17.         arr4(x, 2) = Split(arr2(x - 1), ",")(1)
    
18.         arr4(x, 3) = Split(arr2(x - 1), ",")(2)
    
19.     Next x
    
20.     Range("D1").CurrentRegion.Clear
    
21.     [D1] = "????": [E1] = "????1": [F1] = "????2"
    
22.     [d2].Resize(Dic.Count, 3) = arr4
    
23.     Range("D1").CurrentRegion.EntireColumn.AutoFit
    
24.     Range("D1").CurrentRegion.Borders.LineStyle = 1
    
25. End Sub
    
26. Sub ???()
    
27.      Range("D1").CurrentRegion.Clear
    
28. End Sub
    

复制代码