案例
案例来源：Excel和Access （微信公众号）点击 - 查看原文
做一个简单的查询系统：在这个查询系统中，利用姓名来作为查找的条件，来查找姓名信息的所有结果。
附件：点击查看-百度云
提取密码：0anq
1、源数据
可以直接复制代码进Excel，生成案例数据。
Sub 案例源数据()
Cells(1, 1) = "姓名"
Cells(1, 2) = "年级"
Cells(1, 3) = "语文"
Cells(1, 4) = "数学"
Cells(1, 5) = "英语"
'录入学生姓名
Cells(2, 1) = "张三丰"
Cells(3, 1) = "风清杨"
Cells(4, 1) = "张九明"
Cells(5, 1) = "陈明"
Cells(6, 1) = "古月生"
Cells(7, 1) = "周杰"
Cells(8, 1) = "刘万丰"
Cells(9, 1) = "曾清杰"
Cells(10, 1) = "程杰芳"
Cells(11, 1) = "辛小龙"
Cells(12, 1) = "张天"
Cells(13, 1) = "强强"
Cells(14, 1) = "林明荣"
Cells(15, 1) = "佟明小"
'录入年级
Range("b2:b5") = "1年级"
Range("b6:b11") = "2年级"
Range("b12:b15") = "3年级"
'录入语文成绩
Cells(2, 3) = 98
Cells(3, 3) = 91
Cells(4, 3) = 74
Cells(5, 3) = 71
Cells(6, 3) = 59
Cells(7, 3) = 86
Cells(8, 3) = 78
Cells(9, 3) = 83
Cells(10, 3) = 81
Cells(11, 3) = 70
Cells(12, 3) = 82
Cells(13, 3) = 76
Cells(14, 3) = 68
Cells(15, 3) = 86
'录入数学成绩
Cells(2, 4) = 50
Cells(3, 4) = 88
Cells(4, 4) = 92
Cells(5, 4) = 67
Cells(6, 4) = 50
Cells(7, 4) = 74
Cells(8, 4) = 92
Cells(9, 4) = 62
Cells(10, 4) = 92
Cells(11, 4) = 80
Cells(12, 4) = 61
Cells(13, 4) = 60
Cells(14, 4) = 81
Cells(15, 4) = 95
'录入英语成绩
Cells(2, 5) = 94
Cells(3, 5) = 90
Cells(4, 5) = 61
Cells(5, 5) = 65
Cells(6, 5) = 81
Cells(7, 5) = 80
Cells(8, 5) = 60
Cells(9, 5) = 95
Cells(10, 5) = 85
Cells(11, 5) = 83
Cells(12, 5) = 62
Cells(13, 5) = 88
Cells(14, 5) = 79
Cells(15, 5) = 69
'录入查询界面
Range("g1") = "请输入姓名:"
Range("i1:k1").Merge
Range("i1") = "(支持通配符查找,?单个，*多个)"
Range("a1:e1").Copy Range("g2")
'格式调整
Range("a1:e15").Borders.LineStyle = 1 '画边框
Range("g1:k2").Borders.LineStyle = 1
Range("a1:e1").Interior.ColorIndex = 6 '背景色
Range("g2:k2,h1").Interior.ColorIndex = 53
Range("g2:k2,h1").Font.ColorIndex = 2 '字体颜色
End Sub
查询
查询方法一
Sub 查询方法一()
'ravlee
Dim i, n As Integer
n = 2000
Range("g3:k" & n).Clear '查询前，清除已有信息
If Range("h1") = "" Then Exit Sub '判断查询关键字，是否为空
For i = 2 To Range("a" & n).End(xlUp).Row
If Range("a" & i) Like Range("h1") Then
Range("a" & i & ":" & "e" & i).Copy Range("g" & Range("g" & n).End(xlUp).Row + 1)
End If
Next
'定义循环次数i和可查询范围N
'使用End(xlup).row定位实际查找区域
'通过if判断姓名是否类似，类似情况下将学生信息复制到G行开始的单元格区域，通过G列End(xlUp).row定位最后一行
End Sub
查询方法二
Sub 查询方法二()
'ravlee
Dim m, k, n As Integer
Dim Rng As Range
n = 2000
Range("g3:K" & n).Clear
For Each Rng In Range("a2:a" & Range("a" & n).End(xlUp).Row)
m = m + 1
If Rng Like Range("h1") Then
k = k + 1
Range("a" & m + 1 & ":e" & m + 1).Copy Destination:=Range("g" & k + 2)
End If
Next
'设定大循环，Rng在区域A列的姓名内。
'设定m=m+1，其初始默认值为1；然后在实际引用时+1，实际为Range("a2:e2")
'设定k=k+1,其初始默认值为1；然后在实际引用时+2，实际为Range("g3")
'通过if判断姓名是否类似，并分隔m=m+1和k=k+1。K在if里，只有姓名类似时，循环才会增加值。而m不管名字是否类似，均会增加值
End Sub
