精华内容
下载资源
问答
  • I am not able to use the Find function of VBA. 解决方案 Here's an example of using Find and formatting the found cells Sub FindERROR() Dim SearchString As String Dim SearchRange As Range, cl As Range...

    I am trying to search for a particular string "ERROR" in all the worksheets in the workbook and make it bold and color the found cell red.

    I am able to parse through each worksheet. I am not able to use the Find function of VBA.

    解决方案

    Here's an example of using Find and formatting the found cells

    Sub FindERROR()

    Dim SearchString As String

    Dim SearchRange As Range, cl As Range

    Dim FirstFound As String

    Dim sh As Worksheet

    ' Set Search value

    SearchString = "ERROR"

    Application.FindFormat.Clear

    ' loop through all sheets

    For Each sh In ActiveWorkbook.Worksheets

    ' Find first instance on sheet

    Set cl = sh.Cells.Find(What:=SearchString, _

    After:=sh.Cells(1, 1), _

    LookIn:=xlValues, _

    LookAt:=xlPart, _

    SearchOrder:=xlByRows, _

    SearchDirection:=xlNext, _

    MatchCase:=False, _

    SearchFormat:=False)

    If Not cl Is Nothing Then

    ' if found, remember location

    FirstFound = cl.Address

    ' format found cell

    Do

    cl.Font.Bold = True

    cl.Interior.ColorIndex = 3

    ' find next instance

    Set cl = sh.Cells.FindNext(After:=cl)

    ' repeat until back where we started

    Loop Until FirstFound = cl.Address

    End If

    Next

    End Sub

    展开全文
  • 写了一个VBA宏程序,用来自动将EXCEL一列转换为不同的工作表。例如: 姓名 性别 张三 男 李四 女 通过该程序可以自动分离出“男”工作表和“女”工作表。先上代码,注释写的很清楚。 '时间:2/6/2015 '版本:1.0 ...

    写了一个VBA宏程序,用来自动将EXCEL一列转换为不同的工作表。例如:

    姓名  性别

    张三  男

    李四  女

    通过该程序可以自动分离出“男”工作表和“女”工作表。先上代码,注释写的很清楚。

    在excel中先使用alt+F11组合键打开代码窗口,在当前项目中新建一个模块(modules),复制代码到当前模块。使用ctrl+G打开调试窗口,复制代码并执行。

    '时间:2/6/2015
    '版本:1.0
    
    '宏SeperateColumn用来将当前工作表,按某一列进行分类,每一类新建为以该值变量命名的工作表中,工作表第一行为表头,不进行分离;
    '注意:使用前请提前备份工作簿,最好先搜索目标列确认列值符合工作表命名规范
    
    Sub SeperateColumn()
    
      '定义了需要分离的列
      Dim col As Integer
      
      '从选择的行开始进行迭代分离col列*********************
      col = getSeperateCol()
      
     
         '取得当前工作表的最大行数tableRows
         Dim tableRows As Integer
         tableRows = ActiveSheet.Range("A65535").End(xlUp).Row
         
         '取得当前工作表的名字
         Dim tableName As String
         tableName = ActiveSheet.Name()
         
            '对当前工作表从第二行开始迭代(第一行为表头),取col列的值进行处理
            Dim stringEveryItem As String
            For Index = 2 To tableRows
            
                stringEveryItem = ActiveSheet.Cells(Index, col)
                
                '如果此值在所有的工作表中五法找到则新建一个该名称的工作表并且将该行插入
                If stringExistWorkSheet(stringEveryItem) = False Then
                   resultAddsheet = addWorkSheetCopyFirstRow(tableName, stringEveryItem)
                   resultInsertSheet = copyRowToWorksheet(tableName, Index, stringEveryItem)
                    
                '若此值在所有工作表中能找到,则直接插入到该工作表中
                Else
                   resultInsertExistSheet = copyRowToWorksheet(tableName, Index, stringEveryItem)
                End If
            Next
                    
      Debug.Print "转换完成"
      
      MsgBox "转换完成 Seperate Completed.", vbInformation, "运行结果RESULT"
            
      
    End Sub
    
    '函数stringExistWorkSheet()判断通过值传递来的value_name是否在本workbook中存在该worksheet(这里不区分大小写)
    Function stringExistWorkSheet(ByVal value_name As String) As Boolean
        
        '先定义一个Worksheet对象
        Dim sht As Worksheet
        
        '默认下找不到该Worksheet
        stringExistWorkSheet = False
        
        '下面对该Workbook进行遍历
        For Each sht In ActiveWorkbook.Worksheets
            '比较时worksheet和value_name不区分大小写
            If VBA.LCase(sht.Name) = VBA.LCase(value_name) Then
                stringExistWorkSheet = True
                Exit Function
                
            End If
        Next
    End Function
    '函数addWorkSheetCopyFirstRow(tableName,sName)用来新建一个以sName的工作表,并且将tableName工作表的第一行复制到新工作表的第一行
    Function addWorkSheetCopyFirstRow(ByVal tableName As String, ByVal sName As String) As Boolean
    
        addWorkSheetCopyFirstRow = False
    
        '插入制定名称的工作表
        Worksheets.Add.Name = sName
        
        Debug.Print "创建新工作表"; sName; "成功"
        
        '选中主表的第一行
         Worksheets(tableName).Activate
         Rows(1).Select
        '复制选中的第一行
        Selection.Copy
        
        '选中新建表的第一行
        Sheets(sName).Activate
        Rows(1).Select
        '粘贴
        ActiveSheet.Paste
        
        addWorkSheetCopyFirstRow = True
        Worksheets(tableName).Activate '最后将当前活动工作表还原为主表
        
        Debug.Print "已经复制第一行到"; sName; "工作表"
        
    End Function
    'copyRowToWorksheet函数用来从tableNameCopy工作表中选取第tableNameCopyRow行,然后复制到tableNamePaste表中
    Function copyRowToWorksheet(ByVal tableNameCopy As String, ByVal tableNameCopyRow As Single, ByVal tableNamePaste As String) As Boolean
        
        copyRowToWorksheet = False
        
        '首先将主表设为活动表,选取某行进行复制
        Worksheets(tableNameCopy).Activate
        Rows(tableNameCopyRow).Select
        Selection.Copy
        
        '其次将要粘贴的目的表设为活动表,选取其尾部的行进行粘贴
        Worksheets(tableNamePaste).Activate
        
        '这里使用目的表的最后一行
        Dim rowNumber As Integer
        rowNumber = ActiveSheet.Range("A65535").End(xlUp).Row + 1
        
        Rows(rowNumber).Select
        ActiveSheet.Paste
        
      
        '粘贴成功后还原活动表
        copyRowToWorksheet = True
        Worksheets(tableNameCopy).Activate
        
    End Function
    'getSeperateCol函数通过使用inputbox提供用户选择输入,用来获得需要分离的列,这里先使用数字,后续添加输入列名的功能
    Function getSeperateCol() As Integer
        Dim colIndex As Integer
        
        '这里使用VBA.InputBox提供用户交互
        colIndex = VBA.InputBox("请输入需要分离的列序号(数字)Please input the index of the column which you want to seperate.(Integer)", "选择框CHOOSEBOX")
        
        '这里提供给用户确认选择框
        MsgBox "需要转换的列序号 Column Index:" & colIndex, vbInformation, "提示NOTICE"
        
        getSeperateCol = colIndex
             
    End Function
                                
    
    简述下自己的编程思想:

    首先遍历当前工作表的第二行至最后一行,根据选定的列进行迭代;这里,通过拆分功能区域,将程序拆分出1.遍历所有工作表名称。2,新建工作表并复制第一行。3,复制某一行到目标工作表。4,用户交互。4个函数区,分别实现测试,然后在主函数中调用。有效降低了编程的复杂性。

    展开全文
  • 1.同一目录下的多工作簿,每个工作簿中有一张或多张工作表,一键全部汇总 Sub 合并目录所有工作簿全部工作表() Dim MP, MN, AW, Wbn, wn Dim Wb As Workbook Dim i, a, b, d, c, e Application.ScreenUpdating...

    1. 同一目录下的多工作簿,每个工作簿中有一张或多张工作表,一键全部汇总

    Sub 合并目录所有工作簿全部工作表()
    
    Dim MP, MN, AW, Wbn, wn
    
    Dim Wb As Workbook
    
    Dim i, a, b, d, c, e
    
    Application.ScreenUpdating = False
    
    MP = ActiveWorkbook.Path
    
    MN = Dir(MP & "\" & "*.xls")
    
    AW = ActiveWorkbook.Name
    
    Num = 0
    
    e = 1
    
    Do While MN <> ""
    
    If MN <> AW Then
    
    Set Wb = Workbooks.Open(MP & "\" & MN)
    
    a = a + 1
    
    With Workbooks(1).ActiveSheet
    
    For i = 1 To Sheets.Count
    
    If Sheets(i).Range("a1") <> "" Then
    
    Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)
    
    d = Wb.Sheets(i).UsedRange.Columns.Count
    
    c = Wb.Sheets(i).UsedRange.Rows.Count - 1
    
    wn = Wb.Sheets(i).Name
    
    .Cells(1, d + 1) = "表名"
    
    .Cells(e + 1, d + 1).Resize(c, 1) = MN & wn
    
    e = e + c
    
    Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)
    
    End If
    
    Next
    
    Wbn = Wbn & Chr(13) & Wb.Name
    
    Wb.Close False
    
    End With
    
    End If
    
    MN = Dir
    
    Loop
    
    Range("a1").Select
    
    Application.ScreenUpdating = True
    
    MsgBox "共合并了" & a & "个工作薄下全部工作表。如下:" & Chr(13) & Wbn, vbInformation, "提示"
    
    End Sub
    
    

    2. 同一工作簿中的多工作表,将指定的多工作表一键汇总

    Sub huizongdata()
    
        Rows("2:10000").Clear
         '第一步是先清空汇总表的数据,这里是从第2行开始清理到10000行,可以自己修改。
         
        Application.Wait Now + TimeValue("00:00:01")   '延迟1秒
        
        Dim st As Worksheet, rng As Range, rrow As Integer, i As Integer
        
        '定义一些需要用到的变量
        
        'For Each st In Worksheets  循环开始,遍历所有的工作表
        For i = 3 To Worksheets.Count
        
            Set st = Sheets(i)
            
            Set rng = Range("A10000").End(xlUp).Offset(1, 0)
            
            '每次循环就动态定位需要拷贝数据的区域,即获得A列第一个空的单元格
            
            rrow = st.Range("A2").CurrentRegion.Rows.Count - 1
            
            '获得每个工作表中的数据记录数,即行数,同时需要减去表头的行数,这里是减掉2行。
            
            st.Range("A2").Resize(rrow, 9).Copy rng
            
            '将数据扩展rows行,4列拷贝到数据,并粘贴到汇总表
        
        Next i
       
    
    End Sub
    

     

    展开全文
  • Sheets("评级审批表").PrintOut Copies:=ol '打印指定工作表 ActiveWorkbook.Save '保存当前工作簙 ActiveWorkbook.Close '关闭当前工作簙 Next i '打开下一个工作簙 Else MsgBox "没有找到任何工作簿文件" '...
  • 我想通过从另一个Excel工作表“效率”中提取数据,在一个Excel工作表“Ship”上构建一个表 . “效率”表上的行数据按“发货... 我希望能够在行中搜索“已发货”并复制匹配行的列A,D:F和H,并从“发货”工作表的单...

    我想通过从另一个Excel工作表“效率”中提取数据,在一个Excel工作表“Ship”上构建一个表 . “效率”表上的行数据按“发货”,“离开”,“导入”和“导出”进行分类 . 每个类别(装运,休假,进口,出口)都有几个项目,它们没有特定的顺序 . “效率”表上的表占据A:H列,从第2行开始;长度可以变化 . 我希望能够在行中搜索“已发货”并复制匹配行的列A,D:F和H,并从“发货”工作表的单元格B4开始粘贴它们 . 有人可以帮我吗?

    子船()

    ActiveSheet.Range("$A$1:$H$201").AutoFilter Field:=4, Criteria1:="Shipped"

    ' this is looking in a specific range, I want to make it more dynamic

    Range("A4:A109").Select

    'This is the range selected to copy, again I want to make this part more dynamic

    Application.CutCopyMode = False

    Selection.Copy

    Range("A4:A109,D4:F109,H4:H109").Select

    Range("G4").Activate

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("Ship").Select

    Range("B4").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

    :=False, Transpose:=False

    结束子

    展开全文
  • 我若是码农,我还会来搜索这个Soluation吗? 要么购买第三方工具,购买?NO.NO.NO,没有预算; 那怎么办,自然就会想到Excel 的VBA, 作为VBA,看上去简单,其实时间成本特别高,效率低; 现在就分享一个资源,...
  • 需求说明 一个doc文档中有大量的特殊样式文本,使用相同的样式黑体,三号(16),红色...VBA代码实现 Sub batchEdit() ' ' 批量根据样式修改文本内容 ' With Selection.Find.Font .NameFarEast = "黑体" .Size = 16 ...
  • 在Excel的使用过程中,经常需要引用其他工作簿的数据...如果需要引用的数据不是太多,可以使用公式取得引用工作簿中的工作表数据,如下面的代码所示。 Sub CopyData_1() Dim Temp As String Temp = "'" & T...
  • 当单个excel工作簿有很多工作表时,使用起来会有麻烦,虽然excel提供隐藏工作表功能,但点击及查找并不方便。如果能够在一个工作表中实现目录索引功能,点击按钮即可隐藏/显示对应工作表,会非常方便操作和查看。 ...
  • String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配。 语法 Dir[(pathname[, attributes])] Dir 函数的语法具有以下几个部分: 部分 描述 pathname...
  • VBA常用技巧

    2014-12-21 16:39:28
    技巧48 保存指定工作表为工作簿文件 12 技巧49 打印预览时不触发事件 12 技巧50 设置工作簿文档属性信息 12 技巧51 不打开工作簿取得其他工作簿数据 12 51-1 使用公式 12 51-2 使用GetObject函数 12 51-3 隐藏...
  • 1、先说第一种情况:遍历所有工作表,是否存在某一个关键词 Sub 搜索确认() Dim sht As Worksheet, a For Each sht In Worksheets sht.Activate Set a = Cells.Find(What:="测试") 'Debug.Print(),可
  • 最近在做水质分析数据录入的时候,需要根据监测井编号到多个excel中查询该编号对应的井的水质分析数据,并将单口井的水质分析数据复制到新中。由于检测中心给的 水质分析数据很多,而且还分布在不同的工作薄中,...
  • 由于商品目录升级,现商品编码中以“GXGY”的所有记录统一更换为“GXGYA”,该如何通过VBA批量实现? 商品编码 替换结果 GXGY023 GXGYA023 GXGY024 GXGYA024 QDJC022 QDJC022 qdjc023 qdjc...
  • Option Explicit Sub FileNames() Dim sFName As String Dim asFNames() As String Dim sFType As String ... sFName = Dir(sFType) 'Dir函数返回sFType中找到的与通配符...代码摘自<<Excel 2007 VBA 参考大全>>
  • 问题 左上角为a1 比如其中,key2 ,key4, key6 后面都可能带空格 key1 key2 key3 key4 key5 key6 key7 key8 key9 key10 key11 key12 key10 key10 ...VBA方法 所有的工...
  • 最近工作需要将多个采购单的数据汇总到一张中查看,因为每张采购单格式相同,且每个采购单对应一个sheet,现在想把张三明细、李四明细中的每月采购总额、期初应付款余额、供应商名称等汇总到一张sheet中,去网上...
  • 发现系统批量搜索Excel中的文字不好用,替换更无从谈起,于是利用VBA自己搞。 1、点击固定一个单元格,激发对话框打开事件,选定要搜索的文件夹。 2、选定后自动在该单元格下列出文件夹路径,和文件列表同时加载...
  • 如图所示,该为某公司采购清单。由于在记录时并未标记供应商来源地,只能通过E列供应商名称中寻找。现需要筛选出所有上海的供应商采购记录,该如何用VBA实现? 商品编码 入库日期 部门 业务员 供应...
  • 函数作用:在多个工作表中查找一个范围内符合某个指定条件的项目对应指定范围加总求和..........................59 '35.函数作用:返回 Column 英文字.......................60 '36.函数作用:查找指定列名的列数.......
  • VBA实现多个Sheet页匹配关键字并汇总

    千次阅读 2018-06-06 10:36:28
     用户需求:媳妇统计excel时需要在多个sheet页中搜索关键字,找到匹配的行后再粘贴到新的sheet页中,然后问我有什么快捷的方法,一键式的。 我想了想写个宏,碎碎个事。好了,开始! 实现思路:打开excel,新建一...
  • application.worksheetfunction.find() 更适合工作表 application.find() 更适合VBA 虽然VBA可能自带一些函数,比如VBA.find() 就没有,但即使有,和application的功能一般都是不同的。 Sub test503() Debug.Print ...
  • 1.查询语句如下: Select CONCAT( 'drop table ', table_name, ';...【注:help是表名搜索的关键字】 2.结果如下: 【注:相当于将变量信息进行字符串拼接】 3.将结果粘贴出来,直接执行: 4.执行成功...
  • VBA-加快你的代码运行速度--转自ExcelHome

    千次阅读 多人点赞 2020-05-14 14:42:32
    我们知道,用VBA实现同一个效果可能有多种不同的方法,写出一个最有效率的代码是大家都追求的,但是假如我水平有限,经验不足,实践不多,或者逻辑线路的设计不够简洁清爽,是不是就无法大幅提高代码速度?当然不是,如果你...
  • Vba菜鸟教程

    万次阅读 多人点赞 2020-05-02 18:21:15
    文章目录Vba菜鸟教程编辑器宏vba基本语法运算符变量语句简写语句sub语句调用语句退出语句分支语句循环语句判断语句公式与函数在单元格输入公式利用单元格公式返回值调用工作表函数利用vba函数自定义函数操作对象操作...
  • 获取当前文件夹的名称(CurDir 函数)当你使用文件时,经常会需要知道当前文件夹的名称,你使用CurDir函数轻易地获取该信息:CurDir([drive])Drive是一可选参数,如果你忽略它,VBA将使用当前驱动(drive)。CurDir函数...
  • 第16章介绍了使用VB开发AutoCAD的一些知识(将VBA代码转换到VB中,VB窗体和AutoCAD的焦点切换,使用ActiveXDLL封装带有窗体的VB程序)、搜索某个文件夹中所有的文件和VBAIDE的编程,利用这些知识,完全有可能开发出...
  • 编写该代码的目的:初衷该代码最初用于我自己弄得一个用于批量化写word报告的东西,因为我原来需要写一堆格式化的报告,不同报告间除了数据发生了变化,其他几乎一模一样,我想偷懒(主要是我容易写错),就使用VBA写...
  • Excel VBA高级编程 -根据日期查找数据

    千次阅读 2020-08-11 22:43:20
    工作表使用VBA实现了如下功能: 1、实时统计重复项 2、重复项数据自动求和 附上代码 Sub lqxs() Dim Cnn As Object, SQL$, shnm$, arr, i&, j& Set Cnn = CreateObject("Adodb.Connection") shnm...
  • VBA文件及文件夹操作

    2021-08-12 11:08:39
    VBA文件及文件夹操作1.VBA操作文件及文件夹on error resume next下测试A,在D:\下新建文件夹,命名为folder方法1:MkDir "D:\folder"方法2:Set abc =CreateObject("Scripting.FileSystemObject")abc.CreateFolder...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 1,239
精华内容 495
关键字:

vba搜索指定工作表