显示工作表中单条记录详情，用上一条、下一条切换。求大侠帮助，万分感激！

avar

请教各位大侠：
工作表中有多条记录，每条记录有详情。
想在另一个工作表中显示单条记录详情，并用《上一条》、《下一条》以及《转到代码：》切换来逐条查看。
请见下图：
A表是这样的：

A表

B表查看：

B表

附件示例： 机构名录.rar (10.58 KB, 下载次数: 21)

2015-8-24 11:50 上传

点击文件名下载附件

不知能否实现？因本人菜鸟，不知如何入手，望大侠帮助编写VBA！
感谢！

wzb5566

1. Sub 转到代码()
   
2. Dim rng As Range
   
3. Set rng = Sheets("A").Columns(1).Find(Sheets("B").[C9].Value, lookat:=xlWhole)
   
4. If Not rng Is Nothing Then
   
5.     lr = rng.Row
   
6.     With Sheets("A")
   
7.         Sheets("B").[B2] = rng
   
8.         Sheets("B").[D2] = .Cells(lr, "B")
   
9.         Sheets("B").[B3] = .Cells(lr, "C")
   
10.         Sheets("B").[B4] = .Cells(lr, "D")
    
11.         Sheets("B").[D4] = .Cells(lr, "H")
    
12.         Sheets("B").[B5] = .Cells(lr, "E")
    
13.         Sheets("B").[D5] = .Cells(lr, "F")
    
14.         Sheets("B").[B6] = .Cells(lr, "G")
    
15.     End With
    
16. Else
    
17.     MsgBox "代码不存在"
    
18. End If
    
19. End Sub

复制代码

wzb5566

在B表C9中填写代码，请测试。

wzb5566

1. Sub 上一条()
   
2. Dim rng As Range
   
3. Set rng = Sheets("A").Columns(1).Find(Sheets("B").[C9].Value, lookat:=xlWhole)
   
4. If Not rng Is Nothing Then
   
5.     If rng.Row = 2 Then
   
6.         MsgBox "已至顶行"
   
7.     Else
   
8.         lr = rng.Offset(-1, 0).Row
   
9.         With Sheets("A")
   
10.             Sheets("B").[C9] = rng.Offset(-1, 0)
    
11.             Sheets("B").[B2] = rng.Offset(-1, 0)
    
12.             Sheets("B").[D2] = .Cells(lr, "B")
    
13.             Sheets("B").[B3] = .Cells(lr, "C")
    
14.             Sheets("B").[B4] = .Cells(lr, "D")
    
15.             Sheets("B").[D4] = .Cells(lr, "H")
    
16.             Sheets("B").[B5] = .Cells(lr, "E")
    
17.             Sheets("B").[D5] = .Cells(lr, "F")
    
18.             Sheets("B").[B6] = .Cells(lr, "G")
    
19.         End With
    
20.     End If
    
21. Else
    
22.     MsgBox "代码不存在"
    
23. End If
    
24. End Sub
    
25. Sub 下一条()
    
26. Dim rng As Range
    
27. Set rng = Sheets("A").Columns(1).Find(Sheets("B").[C9].Value, lookat:=xlWhole)
    
28. lrd = Sheets("A").[A65536].End(xlUp).Row
    
29. If Not rng Is Nothing Then
    
30.     If rng.Row = lrd Then
    
31.         MsgBox "已至尾行"
    
32.     Else
    
33.         lr = rng.Offset(1, 0).Row
    
34.         With Sheets("A")
    
35.             Sheets("B").[C9] = rng.Offset(1, 0)
    
36.             Sheets("B").[B2] = rng.Offset(1, 0)
    
37.             Sheets("B").[D2] = .Cells(lr, "B")
    
38.             Sheets("B").[B3] = .Cells(lr, "C")
    
39.             Sheets("B").[B4] = .Cells(lr, "D")
    
40.             Sheets("B").[D4] = .Cells(lr, "H")
    
41.             Sheets("B").[B5] = .Cells(lr, "E")
    
42.             Sheets("B").[D5] = .Cells(lr, "F")
    
43.             Sheets("B").[B6] = .Cells(lr, "G")
    
44.         End With
    
45.     End If
    
46. Else
    
47.     MsgBox "代码不存在"
    
48. End If
    
49. End Sub

复制代码

wzb5566

请测试。。

avar

wzb5566 发表于 2015-8-24 12:48
请测试。。

太崇拜您了！下来好好学习了。
感谢！

haisea888888

楼上的哥哥帮忙把这个看一下如何搞