[已解决]求助一个搜索功能并分类显示

a57768932

在sheet1 单元格A10中输入内容  单机COMMAND按钮   点击后    在sheet2中搜索所有带有A10单元格内容          搜索到的字符显示在D13和F13中   这代码怎么写{:021:}

最佳答案

月排行榜 / 总排行榜

xdragon

2014-8-9 14:07

a57768932 发表于 2014-8-9 13:27
有点出入     举个例子  不如说 我在sheet1 D10里输入    10     在下方显示   
D13  显示   10    a109 ...

1. Private Sub CommandButton1_Click()
   
2.    Dim arr, i&, j%, cnt&, re(1 To 16, 1 To 2), v, d As Object
   
3.    arr = Sheet2.Range("A1").CurrentRegion.Value
   
4.    v = Range("D10").Value
   
5.    cnt = 12
   
6.    Set d = CreateObject("scripting.dictionary")
   
7.    For i = 1 To UBound(arr)
   
8.       For j = 1 To UBound(arr, 2)
   
9.          If InStr(arr(i, j), v) And Not d.exists(i) Then
   
10.                cnt = cnt + 1
    
11.                d(i) = ""
    
12.                Cells(cnt, 4) = arr(i, 1)
    
13.                Cells(cnt, 6) = arr(i, 2)
    
14.           End If
    
15.       Next
    
16.     Next
    
17. End Sub

复制代码

建议下次最好有个模拟结果，因为我不知道你想要包含还是精确匹配的，哈哈

跳转到最佳答案楼层

xdragon

1. Private Sub CommandButton1_Click()
   
2.    Dim arr, i&, j%, cnt&, re(1 To 16, 1 To 2), v
   
3.    arr = Sheet2.Range("A1").CurrentRegion.Value
   
4.    v = Range("D10").Value
   
5.    cnt = 12
   
6.    For i = 1 To UBound(arr)
   
7.       For j = 1 To UBound(arr, 2)
   
8.          If arr(i, j) = v Then
   
9.             cnt = cnt + 1
   
10.             Cells(cnt, 4) = arr(i, 1)
    
11.             Cells(cnt, 6) = arr(i, 2)
    
12.         End If
    
13.       Next
    
14.     Next
    
15. End Sub

复制代码

pengyx

不知为什么要在A10中输入内容，不过按你的写了一个。试试不行就删了

a57768932

pengyx 发表于 2014-8-8 23:35
不知为什么要在A10中输入内容，不过按你的写了一个。试试不行就删了

你这个确实行不通   楼上那个挺接近了

a57768932

xdragon 发表于 2014-8-8 22:48

有点出入     举个例子  不如说 我在sheet1 D10里输入    10     在下方显示   
D13  显示   10    a109
D14             1     a100
D15              2     a101
D16              3     a102
D17              4     a103
.                        .
.                        .
.                        .
.                        .
.                        .
.                        .

xdragon

a57768932 发表于 2014-8-9 13:27
有点出入     举个例子  不如说 我在sheet1 D10里输入    10     在下方显示   
D13  显示   10    a109 ...

1. Private Sub CommandButton1_Click()
   
2.    Dim arr, i&, j%, cnt&, re(1 To 16, 1 To 2), v, d As Object
   
3.    arr = Sheet2.Range("A1").CurrentRegion.Value
   
4.    v = Range("D10").Value
   
5.    cnt = 12
   
6.    Set d = CreateObject("scripting.dictionary")
   
7.    For i = 1 To UBound(arr)
   
8.       For j = 1 To UBound(arr, 2)
   
9.          If InStr(arr(i, j), v) And Not d.exists(i) Then
   
10.                cnt = cnt + 1
    
11.                d(i) = ""
    
12.                Cells(cnt, 4) = arr(i, 1)
    
13.                Cells(cnt, 6) = arr(i, 2)
    
14.           End If
    
15.       Next
    
16.     Next
    
17. End Sub

复制代码

建议下次最好有个模拟结果，因为我不知道你想要包含还是精确匹配的，哈哈

a57768932

xdragon 发表于 2014-8-9 14:07
建议下次最好有个模拟结果，因为我不知道你想要包含还是精确匹配的，哈哈

太漂亮了  膜拜{:06:}