精华内容
下载资源
问答
  • 使用VBA提取文件夹内所有word文档中的表格数据
  • VBA提取文件夹内所有word文档中的表格数据。
  • vba提取word表格实例,提取word里指定名称的表格信息等等
  • 一、提取单层文件内的文件名 只会提取到文件,如果是文件夹自动忽略。 Sub FileDir() Dim p$, f$, k& '获取用户选择文件夹的路径 With Application.FileDialog(msoFileDialogFolderPicker) '选择文件夹 ...

    一、提取单层文件内的文件名

    只会提取到文件,如果是文件夹自动忽略。

    Sub FileDir()
        Dim p$, f$, k&
        '获取用户选择文件夹的路径
        With Application.FileDialog(msoFileDialogFolderPicker)
       '选择文件夹
            If .Show Then
                p = .SelectedItems(1)
                '选择的文件路径赋值变量P
            Else
                Exit Sub
                '如果没有选择保存路径,则退出程序
            End If
        End With
        If Right(p, 1) <> "\" Then p = p & "\"
        f = Dir(p & "*.*")
        '返回变量P指定路径下带任意扩展名的文件名
        '如果有超过一个文件存在,将返回第一个找到的文件名
        '如果一个文件都没有,则返回空
        [a:a].ClearContents '清空A列数据
        [a1] = "目录"
        k = 1
        Do While f <> ""
        '如果文件名不为空,则……
            k = k + 1
            '累加文件个数
            Cells(k, 1) = f
            f = Dir
            '第二次调用Dir函数,但不带任何参数,则将返回同一目录下的下一个文件。
        Loop
        MsgBox "OK"
    End Sub
    

    二、提取多层文件夹内的文件名

    分别将文件夹名称和文件名提取在表格的A/B列,并对文件名创建了超链接

    Sub AutoAddLink()
        Dim strFldPath As String
        With Application.FileDialog(msoFileDialogFolderPicker)
        '用户选择指定文件夹
            .Title = "请选择指定文件夹。"
            If .Show Then strFldPath = .SelectedItems(1) Else Exit Sub
            '未选择文件夹则退出程序,否则将地址赋予变量strFldPath
        End With
        Application.ScreenUpdating = False
        '关闭屏幕刷新
        Range("a:b").ClearContents
        Range("a1:b1") = Array("文件夹", "文件名")
        Call SearchFileToHyperlinks(strFldPath)
        '调取自定义函数SearchFileToHyperlinks
        Range("a:b").EntireColumn.AutoFit
        '自动列宽
        Application.ScreenUpdating = True
        '重开屏幕刷新
    End Sub
    Function SearchFileToHyperlinks(ByVal strFldPath As String) As String
        Dim objFld As Object
        Dim objFile As Object
        Dim objSubFld As Object
        Dim strFilePath As String
        Dim lngLastRow As Long
        Dim intNum As Integer
        Set objFld = CreateObject("Scripting.FileSystemObject").GetFolder(strFldPath)
        '创建FileSystemObject对象引用
        For Each objFile In objFld.Files
        '遍历文件夹内的文件
            lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            strFilePath = objFile.Path
            intNum = InStrRev(strFilePath, "\")
            '使用instrrev函数获取最后文件夹名截至的位置
            Cells(lngLastRow, 1) = Left(strFilePath, intNum - 1)
            '文件夹地址
            Cells(lngLastRow, 2) = Mid(strFilePath, intNum + 1)
            '文件名
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngLastRow, 2), _
                        Address:=strFilePath, ScreenTip:=strFilePath
            '添加超链接
        Next objFile
        For Each objSubFld In objFld.SubFolders
        '遍历文件夹内的子文件夹
            Call SearchFileToHyperlinks(objSubFld.Path)
        Next objSubFld
        Set objFld = Nothing
        Set objFile = Nothing
        Set objSubFld = Nothing
    End Function
    

     

     

    展开全文
  • VBA脚本可以实现从word文档的多个表中提取数据,每个表格的信息提取到一行。 Sub word2els() Set wdApp = CreateObject(“kwps.application”) path_ = ThisWorkbook.Path wdApp.Documents.Open (path_ & “”...

    该VBA脚本可以实现从word文档的多个表中提取数据,每个表格的信息提取到一行。

    Sub word2els()
    Set wdApp = CreateObject(“kwps.application”)
    path_ = ThisWorkbook.Path
    wdApp.Documents.Open (path_ & “” & “bbb.doc”)
    wdApp.Visible = True
    ThisWorkbook.Sheets(“sheet1”).Cells(1, 1) = “序号” ‘’’ 设置sheet1的第一行第一列单元格内容为“序号”
    ThisWorkbook.Sheets(“sheet1”).Cells(1, 2) = “用例标识” ‘’’ 设置sheet1的第一行第一列单元格内容为“用例标识”
    ThisWorkbook.Sheets(“sheet1”).Cells(1, 3) = “测试类型” ‘’’ 设置sheet1的第一行第一列单元格内容为“测试类型”

    n = wdApp.ActiveDocument.Tables.Count ‘’’'有多少个表格
    excel_line_no = 2
    For i = 1 To n
    zhs = wdApp.ActiveDocument.Tables(i).cell(2, 2) ‘’'提取第i个表格的第二行第三列单元格的内容保存到变量zhs中
    Version = wdApp.ActiveDocument.Tables(i).cell(3, 5) ‘’'提取第i个表格的第三行第五列单元格的内容保存到变量Version中
    env = wdApp.ActiveDocument.Tables(i).cell(3, 7) ‘’'提取第i个表格的第三行第七列单元格的内容保存到变量env中
    ThisWorkbook.Sheets(“Sheet1”).Cells(excel_line_no, 1) = zhs ‘’'将变量zhs的值写入到excel的sheet1的第’excel_line_no 行第1列
    ThisWorkbook.Sheets(“Sheet1”).Cells(excel_line_no, 2) = Version ‘’'将变量Version的值写入到excel的sheet1的第’excel_line_no 行第2列
    ThisWorkbook.Sheets(“Sheet1”).Cells(excel_line_no, 3) = env ‘’'将变量env的值写入到excel的sheet1的第’excel_line_no 行第3列
    excel_line_no = excel_line_no + 1
    Next
    wdApp.Application.Quit '关闭word文档
    Set wdApp = Nothing '释放对象变量的内存

    End Sub

    word文档如下:
    在这里插入图片描述
    提取结果如下:
    在这里插入图片描述

    展开全文
  • 使用方法: 1.打开软件 2.打开一个Excel空白文件并最小...8.这时你会发现第二步骤中新建的Excel文件中已经出现了框选住的表格的Excel版本。 就是这么简单,好用得话评个分吧,第一次发帖,有不对的地方大家多包涵。
  • 将EXCEL表格导入CAD中的VBA源代码

    热门讨论 2011-07-19 19:06:38
    将EXCEL表格导入CAD中的VBA小程序 1、能识别EXCEL表格单元格格式和合并单元格; 2、能设字高比,并保证字在表格内;
  • CAD VBA 获取 cad中文字

    2012-09-26 08:44:32
    获取cad图纸中的文字内容 可以对cad图纸中的文字进行批量修改
  • VBA学习笔记本(二)——两个表格数据匹配_DEMO 将excel中两个工作表中,数据进行一键同步的通用方法
  • 同事需求,要提取单线图中的所有焊口编号和检测报告中的做比对。网上找了个有些麻烦,不能选取非文本,否则报错。于是修改代码如下。 用法: 1、打开cad文件 2、在VB编辑器中复制以下代码,然后运行 3、此时回到...

    同事需求,要提取单线图中的所有焊口编号和检测报告中的做比对。网上找了个有些麻烦,不能选取非文本,否则报错。于是修改代码如下。 

    用法:

    1、打开cad文件

    2、在VB编辑器中复制以下代码,然后运行

    3、此时回到CAD,选取要提取的文本,如果都需要提取,则全选。 选取非文本时脚本会自动跳过。右键完成。

    4、结果保存在d:/output.txt文件内。

    Sub AcadGetText()
        
        Dim sset As AcadSelectionSet   '声明定义选择集
        Dim ent As AcadEntity          '声明实体
        Dim fso, f
        Dim filename As String         '声明文件字符串
        Dim str As String
        
        filename = "d:/output.txt"
        
        Do While ThisDrawing.SelectionSets.Count > 0
            ThisDrawing.SelectionSets.Item(0).Delete
        Loop
        
        Set sset = ThisDrawing.SelectionSets.Add("sst")  '添加选择集
        sset.SelectOnScreen                              '在屏幕上选择对象
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set f = fso.OpenTextFile(filename, 8, True)
        
        ' 可能选取到非文本,所以。。。
        On Error Resume Next
        For Each ent In sset
            str = ""
            str = ent.TextString
            If str <> "" Then f.WriteLine str
        Next
        
        f.Close
        
    End Sub
    
    

    参考于:https://blog.csdn.net/maokaijiang/article/details/5814147

    自己修改了些代码,用于处理选取了非文本时报错问题。也更换了写文件的方式。

    --

    2021.1.19 锦采

    展开全文
  • VBA提取html的table数据

    2020-09-02 11:40:21
    Sub test() Dim oDom As Object: Set oDom = CreateObject("htmlFile") Dim x As Long, y As Long Dim oRow As Object, oCell As Object Dim data y = 1: x = 1 With CreateObject("msxml2.xmlhttp") ...
    Sub test()
    
    Dim oDom As Object: Set oDom = CreateObject("htmlFile")
    Dim x As Long, y As Long
    Dim oRow As Object, oCell As Object
    Dim data
    
    y = 1: x = 1
    
    With CreateObject("msxml2.xmlhttp")
    'http://www.bundesbank.de/Navigation/EN/Statistics/Time_series_databases/Macro_economic_time_series/its_details_value_node.html?tsId=BBNZ1.Q.DE.Y.G.0000.A&listId=www_s311_b4_vgr_verw_nominal
        .Open "GET", "http://finance.yahoo.com/q/hp?s=GOOG+Historical+Prices", False
        .Send
        oDom.body.innerHtml = .responseText
    End With
    
    With oDom.getElementsByTagName("table")(0)
        ReDim data(1 To .Rows.Length, 1 To .Rows(1).Cells.Length)
        For Each oRow In .Rows
            For Each oCell In oRow.Cells
                data(x, y) = oCell.innerText
                y = y + 1
            Next oCell
            y = 1
            x = x + 1
        Next oRow
    End With
    
    Sheets(1).Cells(1, 1).Resize(UBound(data), UBound(data, 2)).Value = data
    End Sub
    

    这里是引用
    https://www.it1352.com/737536.html

    展开全文
  • VBA提取PPT中的文字

    千次阅读 2020-02-16 12:16:18
    将以下代码放到VBE中,运行即可提取 Public Sub Main() Dim temp As String, tmpShape As Shape, tmpSlide As Slide Dim pptPageCount As Integer, MyFName As String pptPageCount = Act...
  • 这是我个人运用Excel VBA在EXcel中实现的提取单元格中特定文字,并用”.“来标注此单元格是否存在这个字符的小程序。
  • 一、使用工具及python包介绍 腾讯云API 国内大型互联网公司都提供云服务,如阿里、百度、腾讯等。本文选择腾讯云服务,是因为提供的API说明比较详细,看一遍就能用。...xlwings 用来与Excel进行交互,几乎可以取代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...
  • 因为从气象站获取的气象数据大都是矩阵形式的,列为站点,行为日期,但是在跑模型的时候需要把这种矩阵类型的数据转为一条一条的向量数据,可以在excel中利用一下VBA代码批量处理多个excel/csv文件: Sub a() Dim ...
  • vba6.3提取自WPS2012专业增强版(带教程),需要表格红插件就下载这个
  • 0、表格内容 A列 B列 手机2134 型号324 2135手机 325型号 2手机136 32型号6 1、Word法 1.1 提取非数字 遇事不决就去隔壁找Word,将表格A列内容复制到Word中,打开“替换”窗口,输入[0-9],点开“高级搜索”勾选...
  • [code="java"]'*** ' 生成文件 '***** Sub cTest() Dim cursheet As Worksheet Set cursheet = Worksheets("Sheet1") Dim localPath As String ... localPath = ...
  • excel中VBA提取文件夹名称的方法

    千次阅读 2016-08-09 15:15:54
    内容提要:文章介绍excel中使用VBA代码来提取文件夹名称的具体操作步骤。对Excel感兴趣的朋友可加Excel学习交流群:284029260(www.itblw.com)  在网上看到有人用批处理命令提取文件夹名称。其实在excel中使用VBA...
  • 需求描述: 为了方便管理大量的简历文件,需要将简历文件列表导入Excel中,然后筛选符合条件的简历,并直接在Excel中打开简历文件。 本段代码即可实现以下功能: 1. 支持用户根据实际情况(个人电脑中的文件系统...
  • 如何用VBA提取WORD文档里的图片

    千次阅读 2018-07-17 14:49:46
     Application.ScreenUpdating = False  Dim FileName As String  FileName = InputBox("请输入文件名")  Selection.Copy ... Documents.Add DocumentType:=wdNewBlankDocument ...
  • EXCEL表格VBA更新双色球数据源代码
  • 使用VBA操作Word表格

    万次阅读 2015-05-27 11:12:53
    一、生成表格 Private Sub CreateTable(mRows As Integer, mColumns)  Dim mRange As Range  Set mRange = ActiveDocument.Range  mRange.SetRange Start:=ActiveDocument.Range.End, End:=ActiveDocument.Ra
  • VBA生成文本文件的几种方法

    千次阅读 2019-10-15 16:05:21
    一、 创建脚本生成器对象,通过脚本生成器对象生成文本文件。 Set Fso = CreateObject(“Scripting.FileSystemObject”) Set sFile = Fso.CreateTextFile...'Excel中VBA转换文件编码到UTF-8 Public Function Con...
  • AutoCad vba二次开发(图框,明细表)

    热门讨论 2008-11-01 10:09:32
    功能:(1)实现符合国家标准的图框,标题栏,明细表的定制,用户也可以自定义图框尺寸和标题栏明细表等样式。(2)一些机械行业常用的绘图设置,如内螺纹、外螺纹、螺纹孔、中心孔、腹板式齿轮、符合国家标准尺寸...
  • Excel-VBA正则表达式提取文本案例

    千次阅读 2019-10-02 23:47:44
    背景是这样的,我手上有一份统计表,需要将IP地址里的省市提取出来,以便于处理。因此我首先想到了Python里的正则表达式,打算写一个自定义函数去批量提取。然而之前没学VBA里的正则表达式语法,因此就去网上搜了...
  • CAD提取坐标的VBA源码

    2011-09-19 22:46:22
    本小程序可在CAD中点取坐标,可以选择是否手工输入点号和高程。如不选择手工输入点号,则点号自动增加;
  • 背景:业务给了一个大表格,里面几十万条数据,要拆分成成百上千个小表格,思来想去,vba做这件事是效率最高的。 样表数据源: 请按照这个表头在excel中制作样表(最好将样表放在一个空文件夹里面) 然后调出VB编辑器...
  • VBA 按行提取*.txt文件数据并写入Excel单元格

空空如也

空空如也

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

vba提取表格