Excel VBA范例大全
上QQ阅读APP看本书,新人免费读10天
设备和账号都新为新人

第11章 数据查询与替换

在Excel计算中,查询和替换功能运用相当频繁。熟练掌握这类技巧,可以在制表运算中提升效率,并且确保运算的准确性。

● 实例85查找单价

● 实例86多表成绩搜索

● 实例87电话簿查询

● 实例88循环嵌套进行工号查询

● 实例89将工作表中“PC”批量替换成电脑

● 实例90将大于等于60的考分替换成“合格”

实例85 查找单价

【技巧说明】 查找单价。

【案例介绍】 如图2.97所示,产值表中“产值”列引用“单价”列和“产量”列的数据,而“单价”列数据需要到“单价表”中去引用数据。手工去查询产品对应的单价显然效率低下,本例通过代码瞬间找到所有产品对应的单价。

【案例实现】 参见以下步骤:

[1] 使用快捷键Alt+F11进入VBE(Visual Basic Editor)环境。

[2] 单击菜单【插入】\【模块】,打开模块代码窗口。

[3] 在右边代码窗口输入以下代码:

Sub查找单价()
  Dim var As Variant, iRow As Integer
  iRow=3
  Do Until IsEmpty(Cells(iRow, 1))
      var=Application.Match(Cells(iRow, 2), Sheets("单价表").Columns(1), 0)
      If Not IsError(var) Then
        Cells(iRow, 4).Value=Sheets("单价表").Cells(var, 2).Value
      End If
      iRow=iRow+1
  Loop
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 利用快捷键Alt+F8调出运行宏窗口,然后单击“执行”按钮,“单价”列将产生对应的单价,如图2.98所示。

图2.97 产值表

图2.98 查找单价后的产值表

提示

本实例参见光盘样本:..\第2部分\实例85.xlsm。

【相关知识说明】

(1)Do Until...Loop语句:当条件为True时,或直到条件变为True时,重复执行一个语句块中的命令。本例中表示循环查找单价,直到单元格数据为空时停止。

(2)IsEmpty:返回Boolean值,指出变量是否已经初始化。

(3)Application.Match:返回在指定方式下与指定数值匹配的数组中元素的相应位置。本例中以B列产品名为基准,到“单价表”中查询相同的产品名在A列的排列位置。

实例86 多表成绩搜索

【技巧说明】 在多个工作表中搜索成绩。

【案例介绍】 如图2.99所示,三个班的成绩放置在三个工作表中,现需要在“成绩查询”表的A2中输入人名(也可以是单字),则在后面表格中出现对应的学员所在的工作表和单元格,以及完整姓名、班级、学号与成绩。

图2.99 成绩查询表

【案例实现】 参见以下步骤:

[1] 按Alt+F11组合键进入VBE环境。

[2] 使用快捷键Ctrl+R,显示工程资源管理器。

[3] 双击左边列表中的“成绩查询表”,打开工作表代码窗口。

[4] 在右边代码窗口输入以下代码:

Sub成绩搜索()
Dim t, arr(), intRows As Integer
    t=Timer  '初始化时间变量
    Application.ScreenUpdating=False
    On Error Resume Next
    Range("c2:h1048576").Clear  '清除上次查询信息
    查找值=Cells(2, 1)       '设定查找目标为A2的值
    For i=2 To Sheets.Count   '遍历工作表(第一个表即当前表除外)
      Set c=Sheets(i).Range("a2:a100").Find(what:=查找值)
                      'A2∶A100可以是自己根据实际状况定义区域大小
      If Not c Is Nothing Then
          firstAddress=c.Address
          Do
              intRows=intRows+1 '累加计数器
              ReDim Preserve arr(1 To 6, 1 To intRows)  '重定义数组变量
              arr(1, intRows)=Sheets(i).Name
                              '数组第一子项目赋值为查找到的数据所在工作表名
              arr(2, intRows)=c.Address
                              '数组第二子项目赋值为查找到的数据所在单元格地址
              arr(3, intRows)=c.Value
                          '数组第三子项目赋值为查找到的数据
            arr(4, intRows)=c.Offset(0, 1).Text
                        '数组第四子项目赋值为查找到的数据右移一个单元格的值
            arr(5, intRows)=c.Offset(0, 2).Text
                        '数组第五子项目赋值为查找到的数据右移二个单元格的值
            arr(6, intRows)=c.Offset(0, 3).Text
                        '数组第六子项目赋值为查找到的数据右移三个单元格的值
            Set c=Sheets(i).Range("a2:a100").FindNext(c)
          Loop While Not c Is Nothing And c.Address <> firstAddress
      End If
  Next
  Range("C2:h" & intRows)=Application.Transpose(arr)
                              '将找到的值赋予单元格区域
  Range("C2:h" & intRows).Borders.LineStyle=xlContinuous  '添加边框
  Application.ScreenUpdating=True
  MsgBox Format(Timer-t, "0.00") & "秒"  '提示总运行时间
End Sub

[5] 关闭VBE窗口返回到工作表。

[6] 在单元格A2输入“刘”并回车,右边出现所有姓“刘”的学生的姓名、班级、学号和成绩,如图2.100所示。

图2.100 成绩查询结果

提示

本实例参见光盘样本:..\第2部分\实例86.xlsm。

【相关知识说明】

(1)Clear:清除整个对象,本例中清除单元格中所有信息,包括数据和格式。

(2)WorksheetFunction.Transpose:返回转置单元格区域,即将一行单元格区域转置成一列单元格区域,反之亦然。相当于选择性粘贴中的转置。

实例87 电话簿查询

【技巧说明】 电话簿查询。

【案例介绍】 如图2.101所示,电话簿分置于三个工作表中,现需要在单元格B1中输入任意字符,即可在下面查询区域返回姓名中包含该字符的人员及其相关通信资料。

【案例实现】 参见以下步骤:

[1] 使用快捷键Alt+F11进入VBE环境。

[2] 使用快捷键Ctrl+R,显示工程资源管理器。

[3] 双击左边列表中的“电话查询”表,打开工作表代码窗口。

[4] 在右边代码窗口输入以下代码:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Address="$B$1" Then
      Dim cn As Object, Sql$, sh As Worksheet
      Set cn=CreateObject("ADODB.Connection")
      cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=
      'excel 8.0;imex=1';data source=" & ThisWorkbook.FullName
      Application.ScreenUpdating=False
      Range("A4:d" & [A1048576].End(xlUp).Row+1).Clear
      For Each sh In Worksheets
          If sh.Name <> "电话查询" Then
              Sql="select * from [" & sh.Name & "$] where姓名like '%"
              & [b1].Text & "%'"
              [A65536].End(xlUp).Offset(1,0).CopyFromRecordset cn.Execute(Sql)
          End If
      Next sh
      Application.ScreenUpdating=True
      cn.Close
      Range("A4:d" & [A1048576].End(xlUp).Row).Borders.LineStyle=
      xlContinuous'线型
      Set cn=Nothing
    End If
End Sub

[5] 关闭VBE窗口返回到工作表。

[6] 在单元格B1输入“刘”并回车,下面则出现所有姓“刘”的人员的姓名及相关信息,如图2.102所示。

[7] 如果删除单元格B1的值,则将列出所有电话簿信息。

图2.101 电话簿查询表

图2.102 电话簿查询结果

提示

本实例参见光盘样本:..\第2部分\实例87.xlsm。

【相关知识说明】

(1)CreateObject:创建并返回一个对ActiveX对象的引用。

(2)Open:对文件做任何I/O操作之前都必须先打开文件。Open语句分配一个缓冲区供文件进行I/O(输入/输出)之用,并决定缓冲区所使用的访问方式。

(3)Close:关闭Open语句所打开的I/O文件。

实例88 循环嵌套进行工号查询

【技巧说明】 循环嵌套进行工号查询。

【案例介绍】 本例与实例85需求一致,只是查询代码不同。如图2.103所示,员工工号需要到参照表“人事资料”中查询并返回到B列。

【案例实现】 参见以下步骤:

[1] 使用快捷键Alt+F11进入VBE(Visual Basic Editor)环境。

[2] 单击菜单【插入】\【模块】,打开模块代码窗口。

[3] 在右边代码窗口输入以下代码:

Sub工号查询()
  Application.ScreenUpdating=False
  Dim i, cell As Range
  For i=1 To Range("a1048576").End(xlUp).Row-1
  For Each cell In Range("A2:A" & Range("a1048576").End(xlUp).Row)
  cell.Offset(0, 1)=Sheets("人事资料").Range("B" & WorksheetFunction.
      Match(cell, Sheets("人事资料").Range("a1:a21"), 0))
  Next cell
Next i
Application.ScreenUpdating=True
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 利用快捷键Alt+F8调出运行宏窗口,然后单击“执行”按钮,B列自动返回姓名对应的工号,如图2.104所示。

图2.103 工资表

图2.104 工号查询结果

提示

本实例参见光盘样本:..\第2部分\实例88.xlsm。

【相关知识说明】

本例中用了两层循环:For…和For Each…Next,外层循环是在“工资表”的A列循环,遍历员工的姓名;内层循环是在“人事资料表”的A列数据循环查找人员姓名,找到后取其右边的工号赋予“工资表”中工号列。内存循环将运行多次,次数和外层数据个数(本例中即“工资表”人员个数)相同,外层循环只循环一次。

实例89 将工作表中“PC”批量替换成电脑

【技巧说明】 将工作表中“PC”批量替换成电脑。

【案例介绍】 如图2.105所示,为了使销货表更通俗易懂,现需要将所有“PC”字样更换为“电脑”。

【案例实现】 参见以下步骤:

[1] 使用快捷键Alt+F11进入VBE(Visual Basic Editor)环境。

[2] 单击菜单【插入】\【模块】,打开模块代码窗口。

[3] 在右边代码窗口输入以下代码:

Sub替换()
  ActiveSheet.UsedRange.Replace What:="PC",Replacement:="电脑",LookAt:=xlPart
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 利用快捷键Alt+F8调出运行宏窗口,然后单击“执行”按钮,工作表中已用区域所有“PC”字样已替换成“电脑”,如图2.106所示。

图2.105 销货表

图2.106 替换后的销货表

提示

本实例参见光盘样本:..\第2部分\实例89.xlsm。

实例90 将大于等于60的考分替换成“合格”

【技巧说明】 将所有工作表中成绩大于等于60的考分替换成“合格”。

【案例介绍】 如图2.107所示,三个组别成员的成绩分布于三个工作表中,现需要将三个工作表中成绩大于等于60分的成绩替换为“合格”字样。

【案例实现】 参见以下步骤:

[1] 使用快捷键Alt+F11进入VBE(Visual Basic Editor)环境。

[2] 单击菜单【插入】\【模块】,打开模块代码窗口。

[3] 在右边代码窗口输入以下代码:

Sub多表替换()
    Dim sh_count As Byte, row_count As Long  '声明变量
    For sh_count=1 To Sheets.Count      '为变量赋值,范围是1到工作表数量
    For row_count=2 To Sheets(sh_count).Range("a1048576").End(xlUp).Row
      '为变量赋值
     If Sheets(sh_count).Cells(row_count, 2) >=60 Then  '如果成绩大于等于60
     Sheets(sh_count).Cells(row_count, 2)="合格"    '替换为“合格”
    End If
    Next row_count                                   '重复下一行
    Next sh_count                                   '重复下一个工作表
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 利用快捷键Alt+F8调出运行宏窗口,然后单击“执行”按钮,三个工作表中所有大于等于60分的成绩已替换成“合格”字样,如图2.108所示。

图2.107 成绩表

图2.108 替换后的成绩表

提示

本实例参见光盘样本:..\第2部分\实例90.xlsm。