[已解决]关于 excel VBA 代码编写的 问题，请大神解答

fz1128

怎么用excel VBA在一列数字中查找相同的数字，并将相同数字下方的数字显示到相邻列。假设我现在B1输入数值17，需要在A列查找出数字17，然后数字17下面所有的数字显示到B列，（17在B列不需要显示）请教大神，怎么编写代码

最佳答案

月排行榜 / 总排行榜

yorkchenshunan

2015-10-20 18:16

误解了你的意思，看这个附件

1. Sub test()
   
2. Dim n%, x%, y%, arr, arr2
   
3. n = Application.InputBox("请输入数字", , , , , , , 1)
   
4. If Application.WorksheetFunction.CountIf([a:a], n) = 0 Then MsgBox "无该数据，请重试": Exit Sub
   
5. arr = Range("a1", Range("a65536").End(xlUp))
   
6. ReDim arr2(1 To UBound(arr), 1 To 1)
   
7. For x = 1 To UBound(arr)
   
8.     If arr(x, 1) = n Then
   
9.         y = y + 1
   
10.         arr2(y, 1) = arr(x + 1, 1)
    
11.     End If
    
12. Next x
    
13. [b:b].ClearContents
    
14. [b1].Resize(y) = arr2
    
15. End Sub

复制代码

跳转到最佳答案楼层

fz1128

我已上传截图，请大神帮忙

七彩屋

准确查找，把找到的单元格后面复制到B2后就可以

fz1128

七彩屋 发表于 2015-10-20 16:43
准确查找，把找到的单元格后面复制到B2后就可以

这样工作量很大，一列有2000多数据，怎么能用VBA实现自动查找，然后把下方的数值提取到B列

七彩屋

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim i%, x%
   
3. x = Range("a65536").End(xlUp).Row
   
4. If Target.Address = "$B$1" Then
   
5. Range("b2:b" & Range("b65536").End(xlUp).Row).Clear
   
6. i = Range("a:a").Find(Target, , , xlWhole).Row
   
7. Range(Cells(i + 1, 1), Cells(x, 1)).Copy Range("b2")
   
8. End If
   
9. End Sub

复制代码

七彩屋

工作簿1.rar (12.21 KB, 下载次数: 7)

2015-10-20 16:59 上传

点击文件名下载附件

fz1128

七彩屋 发表于 2015-10-20 16:59

补充一下如果 17 下面是46，那么B列显示数字46 ，在隔n行出现17 下面是57 那么B列显示 46 、57，依次类推，你那个表里面888后面是9 我只要9出现即可，别的数字不显示，代码应该怎么修改？

yorkchenshunan

详见附件

1. Sub test()
   
2. Dim rg As Range
   
3. Set rg = [a:a].Find([b1], , , , , xlNext)
   
4. [b:b].ClearContents
   
5. Range(rg.Offset(1), [a65536].End(xlUp)).Copy [b1]
   
6. End Sub

复制代码

fz1128

yorkchenshunan 发表于 2015-10-20 17:11
详见附件

我要求：在B1输入数值17，需要在A列查找出数字17，然后数字17下面数字显示到B列，（17在B列不需要显示），如果 17 下面是46，那么B列显示数字46 ，在隔n行出现17 下面是57 那么B列显示 46 、57，依次类推。你做的宏按钮，要是能弹出对话框，输入我所要查找的数字，然后在B列显示 所查数字下面的数字（只一个数字），代码应该怎么写，你的代码我试了，实现不了我的要求。

七彩屋

fz1128 发表于 2015-10-20 17:09
补充一下如果 17 下面是46，那么B列显示数字46 ，在隔n行出现17 下面是57 那么B列显示 46 、57，依次类推 ...

工作簿1.rar (12.18 KB, 下载次数: 3)

2015-10-20 18:11 上传

点击文件名下载附件