文档章节

[VBA]关于查找方法(Find方法)的应用(三)

o
 osc_hssgzmz0
发布于 2018/05/04 17:39
字数 2145
阅读 7
收藏 0

「深度学习福利」大神带你进阶工程师,立即查看>>>

5.4 示例四:本示例所列程序将在工作簿的所有工作表中查找数值,提供了采用两种方法编写的程序,一种是Find方法,另一种是SpecialCells 方法。相对来说,使用Find方法比使用SpecialCells方法要快,当然,本示例可能不明显,但对于带大量工作表和数据的工作簿来说,这种速度差异就可以看出来了。(by fanjy from vbaexpress.com)。
示例代码如下,代码中有简要的说明。
‘- - -使用Find方法 - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub QuickSearch()
  Dim wks As Excel.Worksheet
  Dim rCell As Excel.Range
  Dim szFirst As String
  Dim i As Long
  '设置变量决定是否加亮显示查找到的单元格
  '该变量为真时则加亮显示
  Dim bTag As Boolean
  bTag = True
  '使用input接受查找条件的输入
  Dim szLookupVal As String
  szLookupVal = InputBox("在下面的文本框中输入您想要查找的值", "查找输入框", "")

 

  '如果没有输入任何数据,则退出程序
  If szLookupVal = "" Then Exit Sub
    
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
        
  ' ================================================
  ' 添加一个工作表,在该工作表中放置已查找到的单元格地址
  ' 如果该工作表存在,则先删除它
    For Each wks In ActiveWorkbook.Worksheets
      If wks.Name = "查找结果" Then
        wks.Delete
      End If
    Next wks
     
  ' 添加工作表
    Sheets.Add ActiveSheet
  ' 重命名所添加的工作表
    ActiveSheet.Name = "查找结果"
  ' 在新增工作表中添加标题,指明所查找的值
    With Cells(1, 1)
      .Value = "已在下面所列出的位置找到数值" & szLookupVal
      .EntireColumn.AutoFit
      .HorizontalAlignment = xlCenter
    End With
  
  ' ================================================
  ' 定位到刚开始的工作表
    ActiveSheet.Next.Select
    
  ' ================================================
  ' 提示您是否想高亮显示已查找到的单元格
    If MsgBox("您想加阴影高亮显示所有查找到的单元格吗?", vbYesNo, _
              "加阴影高亮显示单元格") = vbNo Then
    ' 如果不想加阴影显示单元格,则将变量bTag值设置为False
      bTag = False
    End If

  ' ================================================
    i = 2
  ' 开始在工作簿的所有工作表中搜索
    For Each wks In ActiveWorkbook.Worksheets
  ' 检查所有的单元格,Find方法比SpecialCells方法更快
      With wks.Cells
        Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)
        If Not rCell Is Nothing Then
          szFirst = rCell.Address
          Do
           ' 添加找到的单元格地址到新工作表中
            rCell.Hyperlinks.Add Sheets("查找结果").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
           '  检查条件判断值bTag,以决定是否加亮显示单元格
             Select Case bTag
                    Case True
                       rCell.Interior.ColorIndex = 19
             End Select
             Set rCell = .FindNext(rCell)
             i = i + 1
          Loop While Not rCell Is Nothing And rCell.Address <> szFirst
        End If
      End With
    Next wks

  ' 释放内存变量
    Set rCell = Nothing
    
  ' 如果没有找到匹配的值,则移除新增工作表
    If i = 2 Then
      MsgBox "您所要查找的数值{" & szLookupVal & "}在这些工作表中没有发现", 64, "没有匹配值"
      Sheets("查找结果").Delete
    End If
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

‘- - - 使用SpecialCells 方法- - - - - - - - - - - - - - - - - - - - - - - - -
Option Compare Text
Sub SlowerSearch()
    Dim wks As Excel.Worksheet
    Dim rCell As Excel.Range
    Dim i As Long
  '设置变量决定是否加亮显示查找到的单元格
  '该变量为真时则加亮显示
    Dim bTag As Boolean
    bTag = True
  '使用input接受查找条件的输入
    Dim szLookupVal As String
    szLookupVal = InputBox("在下面的文本框中输入您想要查找的值", "查找输入框", "")
  
  '如果没有输入任何数据,则退出程序
    If szLookupVal = "" Then Exit Sub
    With Application
      .ScreenUpdating = False
      .DisplayAlerts = False
      .Calculation = xlCalculationManual
          
  ' ==============================================
  ' 添加一个工作表,在该工作表中放置已查找到的单元格地址
  ' 如果该工作表存在,则先删除它
    For Each wks In ActiveWorkbook.Worksheets
      If wks.Name = "查找结果" Then
        wks.Delete
      End If
    Next wks
      
  ' 添加工作表
    Sheets.Add ActiveSheet
  ' 重命名所添加的工作表
    ActiveSheet.Name = "查找结果"
  ' 在新增工作表中添加标题,指明所查找的值
    With Cells(1, 1)
      .Value = "已在下面所列出的位置找到数值" & szLookupVal
      .EntireColumn.AutoFit
      .HorizontalAlignment = xlCenter
    End With
  
  ' ==========================================
  ' 定位到刚开始的工作表
    ActiveSheet.Next.Select
  
  ' ==========================================
    ' 提示您是否想高亮显示已查找到的单元格
    If MsgBox("您想加阴影高亮显示所有查找到的单元格吗?", vbYesNo, _
              "加阴影高亮显示单元格") = vbNo Then
    ' 如果不想加阴影显示单元格,则将变量bTag值设置为False
      bTag = False
    End If

  ' ==========================================
   i = 2
  ' 开始在工作簿的所有工作表中搜索
    On Error Resume Next
    For Each wks In ActiveWorkbook.Worksheets
      If wks.Cells.SpecialCells(xlCellTypeConstants).Count = 0 Then GoTo NoSpecCells
        For Each rCell In wks.Cells.SpecialCells(xlCellTypeConstants)
          DoEvents
          If rCell.Value = szLookupVal Then
           ' 添加找到的单元格地址到新工作表中
             rCell.Hyperlinks.Add Sheets("查找结果").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
           '  检查条件判断值bTag,以决定是否加亮显示单元格
             Select Case bTag
                    Case True
                      rCell.Interior.ColorIndex = 19
             End Select
             i = i + 1
             .StatusBar = "查找到的单元格数为: " & i - 2
          End If
       Next rCell
NoSpecCells:
    Next wks
               
  ' 如果没有找到匹配的值,则移除新增工作表
  If i = 2 Then
    MsgBox "您所要查找的数值{" & szLookupVal & "}在这些工作表中没有发现", 64, "没有匹配值"
    Sheets("查找结果").Delete
  End If
  
  .Calculation = xlCalculationAutomatic
  .DisplayAlerts = True
  .ScreenUpdating = True
  .StatusBar = Empty
  End With
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
示例文档见 Find与SpecialCells查找示例.xls。UploadFiles/2006-9/928569799.rar


6. 其它一些查找方法
可以使用For Each … Next语句和Like运算符进行更精确匹配的查找。例如,下列代码在单元格区域A1:A10中查找以字符“我”开头的单元格,并将其背景色变为红色。
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub test()
  Dim Cell As Range
  For Each Cell In [A1:A10]
    If Cell Like "我*" Then
        Cell.Interior.ColorIndex = 3
    End If
  Next
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
可以输入下图06所示的数据进行测试。

 

 图06:测试的数据

By fanjy in 2006-9-28

****************************************************************************************

 

hner发表评论于2006-10-10 21:39:54
Find方法应用三已看完,对于实例四总结如下:
主要功能:在工作簿的所有工作表中查找数据,并提示是否高亮显示数据,查找数据地址在“查找结果”工作表中反应。
1、判断工作簿中是否存在"查找结果"工作表,如果存在则删除
2、新增一个工作表,改名"查找结果"
3、利用find方法在每个工作表中查找数值
4、根据新增工作表行数有无变化来判断是否找到数据,如果没有找到,则删除新增的查找结果工作表

代码如下:
Sub DifWsFind()
'在不同工作表中查找数值,并将查找结果地址在查找结果工作表中反映,原数值高亮显示
Dim Ws As Worksheet
Dim FlagWs As Worksheet
Dim FindWs As Worksheet
Dim c As Range
Dim FindValue As Long
Dim FirstAddress As String
Dim Irow As Integer
Dim t As String
'当mboolean为true时,查找结果要高亮显示
Mboolean = True

Irow = 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'1、判断工作簿中是否存在"查找结果"工作表,如果存在则删除
For Each FlagWs In ThisWorkbook.Worksheets
If FlagWs.Name = "查找结果" Then
FlagWs.Delete
Exit For
End If
Next FlagWs
'2、新增一个工作表,改名"查找结果"
Set FindWs = Worksheets.Add
FindWs.Name = "查找结果"
FindValue = Val(InputBox("输入要查找的数值:", "输入框"))


If Len(FindValue) = 0 Then End
t = MsgBox("查找结果是否要高亮显示?", vbYesNo, "显示提示")
For Each FlagWs In ThisWorkbook.Worksheets
If FlagWs.Name <> FindWs.Name Then
'3、在每个工作表中查找数值
FlagWs.Cells.Interior.Color = vbWhite
Set c = FlagWs.Cells.Find(what:=FindValue, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Irow = Irow + 1
With FindWs
.Range("a1") = "查找数值:" & FindValue & "所在地址如下:"
c.Hyperlinks.Add FindWs.Cells(Irow, 1), "", "'" & FlagWs.Name & "'!" & c.Address
If t = vbYes Then
c.Interior.Color = RGB(200, 100, 45)
End If


End With
Set c = FlagWs.Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End If
Next FlagWs
'4、根据新增工作表行数有无变化来判断是否找到数据,如果没有找到,则删除新增的查找结果工作表
If Irow = 1 Then
MsgBox "没有查到需要查找的数值" & FindValue
FindWs.Delete
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

通过本实例有如下疑问:
1、由于本人系统重装,原来在vbe中选择某方法,按F1可以出现帮助,但现在不可以了,我记得要安装MSDN的!是不是?
2、认识了超级链接,不过没有帮助还是不得要领,只能照猫画虎,他们的参数没有像FIND方法领略
3、Specialcells在excel中相当于ctrl+g编辑定位功能,它只能定位某些单元格,并非查找!楼主SpecialCells(xlCellTypeConstants)运用它只能定位常量,如果数据全部为常量,则查找的数据要遍布工作表中所有有数据的单元格,运行速度因该很慢,但是搂住的速度比我想象的要快!是不是我理解错了?
for each icell in wks.cells.SpecialCells(xlCellTypeConstants)
我认为相当于
for each icell in wks.cells.usedrange
4、对like认识不够!楼主有没有这方面的专题?
5、楼主什么时候讲解以下sorts在vba中的应用?
o
粉丝 0
博文 500
码字总数 0
作品 0
私信 提问
加载中
请先登录后再评论。
Netty那点事(三)Channel与Pipeline

Channel是理解和使用Netty的核心。Channel的涉及内容较多,这里我使用由浅入深的介绍方法。在这篇文章中,我们主要介绍Channel部分中Pipeline实现机制。为了避免枯燥,借用一下《盗梦空间》的...

黄亿华
2013/11/24
2W
22
访问安全控制解决方案

本文是《轻量级 Java Web 框架架构设计》的系列博文。 今天想和大家简单的分享一下,在 Smart 中是如何做到访问安全控制的。也就是说,当没有登录或 Session 过期时所做的操作,会自动退回到...

黄勇
2013/11/03
3.7K
8
Flappy Bird(安卓版)逆向分析(一)

更改每过一关的增长分数 反编译的步骤就不介绍了,我们直接来看反编译得到的文件夹 方法1:在smali目录下,我们看到org/andengine/,可以知晓游戏是由andengine引擎开发的。打开/res/raw/at...

enimey
2014/03/04
6.2K
18
我的架构演化笔记 功能1: 基本的用户注册

“咚咚”,一阵急促的敲门声, 我从睡梦中惊醒,我靠,这才几点,谁这么早, 开门一看,原来我的小表弟放暑假了,来南京玩,顺便说跟我后面学习一个网站是怎么做出来的。 于是有了下面的一段...

强子哥哥
2014/05/31
976
3
Swift百万线程攻破单例(Singleton)模式

一、不安全的单例实现 在上一篇文章我们给出了单例的设计模式,直接给出了线程安全的实现方法。单例的实现有多种方法,如下面: class SwiftSingleton { } 这段代码的实现,在shared中进行条...

一叶博客
2014/06/20
3.6K
16

没有更多内容

加载失败,请刷新页面

加载更多

Hacker News 简讯 2020-08-15

最后更新时间: 2020-08-15 06:01 Welders set off Beirut blast while securing explosives - (maritime-executive.com) 焊工在固定炸药的同时引爆了贝鲁特爆炸 得分:347 | 评论:302 Factor......

FalconChen
今天
24
0
OSChina 周六乱弹 —— 老椅小猫秋乡梦 梦里石台堆小鱼

Osc乱弹歌单(2020)请戳(这里) 【今日歌曲】 @小小编辑 :《MOM》- 蜡笔小心 《MOM》- 蜡笔小心 手机党少年们想听歌,请使劲儿戳(这里) @狄工 :腾讯又在裁员了,35岁以上清退,抖音看到...

小小编辑
今天
91
2
构建高性能队列,你不得不知道的底层知识!

前言 本文收录于专辑:http://dwz.win/HjK,点击解锁更多数据结构与算法的知识。 你好,我是彤哥。 上一节,我们一起学习了如何将递归改写为非递归,其中,用到的数据结构主要是栈。 栈和队列...

彤哥读源码
今天
17
0
Anaconda下安装keras和tensorflow

Anaconda下安装keras和tensorflow 一、下载并安装Anaconda: Anaconda下载 安装步骤: 如果是多用户操作系统选择All Users,单用户选择Just Me 选择合适的安装路径 然后勾选这个,自动配置环境...

Atlantis-Brook
今天
15
0
滴滴ElasticSearch千万级TPS写入性能翻倍技术剖析

桔妹导读:滴滴ElasticSearch平台承接了公司内部所有使用ElasticSearch的业务,包括核心搜索、RDS从库、日志检索、安全数据分析、指标数据分析等等。平台规模达到了3000+节点,5PB 的数据存储...

滴滴技术
今天
13
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部