精华内容
下载资源
问答
  • Excel VBA 根据Sheet2表格数据处理Sheet1数据,包括:1,对sheet1和sheet2指定数据的循环比较;2,符合条件的数据复制至sheet1,并且用表格颜色进行标记
  • Word VBA中读取Excel表格中数据

    千次阅读 2020-10-30 09:14:13
    Word VBA中读取Excel表格中数据 前天有一个项目需要写详细设计报告,其中有一块重要内容是把Excel的每一行数据做成一个Word表格。一共将近100行数据,如果我一行一行地手动去做,估计手就废了,于是采用Word...

    Word VBA中读取Excel表格中的数据

    前天有一个项目需要写详细设计报告,其中有一块重要内容是把Excel中的每一行数据做成一个Word中的表格。一共将近100行数据,如果我一行一行地手动去做,估计手就废了,于是采用Word VBA。

    基本编程思路

    1. 创建一个空word文档
    2. word文档中,编辑好一个示例表格,作为一个母表,后续所有的表格程序都是复制这张表,然后修改复制后的新表格的数据
    3. 打开Excel,遍历每一行数据
    4. 取这一行关键数据,复制母表,改变复制后的表格数据

    代码片段

    Dim wb As Document
    Set doc = Application.ActiveDocument
    
    Set xlapp = CreateObject("excel.application")
    Set wkBook = xlapp.Workbooks.Open("C:\Users\shenh\Desktop\VBA处理Excel表格\几何拓扑检查项.xlsx")
      For rowNum = 1 To 63
        CheckName = wkBook.Worksheets(1).Cells(rowNum, 3)
        meaning = wkBook.Worksheets(1).Cells(rowNum, 4)
        CheckName = CheckName & "项"
        
        paraCount = doc.Paragraphs.Count
        doc.Paragraphs(paraCount).Range.Text = CheckName & vbCrLf            '写标题
        
        paraCount = doc.Paragraphs.Count
        doc.Paragraphs(paraCount).Range.Text = CheckName & "详细定义见表" & rowNum + 75 & "所示" & vbCrLf         '写标题
        
        paraCount = doc.Paragraphs.Count
        doc.Paragraphs(paraCount).Range.Text = "表 " & rowNum + 75 & " " & CheckName & "定义表" & vbCrLf
    
        
        doc.Tables(1).Range.Copy
        Set endRange = ActiveDocument.Content
        endRange.Collapse Direction:=wdCollapseEnd
        endRange.Paste
        
        doc.Tables(rowNum + 1).Cell(1, 3).Range.Text = CheckName
        doc.Tables(rowNum + 1).Cell(1, 3).Range.Text = meaning
      Next
    MsgBox wkBook.Sheets(1).Cells(1, 5)
    wkBook.Close
    xlapp.Quit
    
    展开全文
  • 很多人都会遇到,有大量格式雷同的表格需要批量处理,但表格中数据行数或页数不同,通过excel的公式很难实现柔性处理,遇到新的表格又需要重新编辑。针对这个问题,我们用通过简单的VBA程序即可实现多表格多页批量...
  • Excel表格,想以其中某一列为索引,查找另一个表格中同样索引的行,找到该行的某个内容复制到原来的表格指定的位置。还可以删除原有表格中重复的内容。应用场景非常多,比如:利用学生学号和考场分配表查找学生...
  • 或者从工作表的一个单元格区域复制到同一工作表另外的单元格区域,或者从工作表的一个单元格区域复制到另一工作表的单元格区域,甚至从工作表的一个单元格区域复制不同工作簿的工作表单元格区域。...

    学习Excel技术,关注微信公众号:

    excelperfect

    在Excel工作表中,复制粘贴是最常用的操作之一。在已经输入的数据中,找到并复制想要的数据,然后粘贴到指定的地方,是再自然不过的操作了。或者从工作表的一个单元格区域复制到同一工作表中另外的单元格区域,或者从工作表的一个单元格区域复制到另一工作表中的单元格区域,甚至从工作表的一个单元格区域复制到不同工作簿中的工作表单元格区域。那么,如何使用VBA代码来实现复制粘贴操作呢?本文将介绍常用的一些代码。

    直接赋值

    如下图1所示,使用代码:

    Range("D1:E2").Value= Range("A1:B2").Value

    将单元格区域A1:B2中的值直接复制到单元格D1:E2中。

    322a39b00d2ced2653e01818ab42b769.png

    图1

    使用Copy方法

    也可以使用Copy方法,将单元格区域A1:B2中的值复制到以单元格D1开头的单元格区域中:

    Range("A1:B2").CopyRange("D1")

    e3ea07eeb023ed02ab7879a7c59a0c56.png

    图2

    使用数组

    如下图3所示,将工作表Sheet4的列A中内容为“完美Excel”的行复制到工作表Sheet5中。

    2eb0d4c3b9a05ed7bfc0e6c8a7ccee7b.png

    图3

    可以使用下面的代码:

    Sub CopyDataByArray()

        Dim arr As Variant

        Dim i As Long

        Dim j As Long

        Dim row As Long

        row = 1

        arr =Sheet4.Range("A1").CurrentRegion.Value

        For i = LBound(arr) To UBound(arr)

            If arr(i, 1) = "完美Excel" Then

                For j = LBound(arr, 2) ToUBound(arr, 2)

                    Sheet5.Cells(row, j).Value =arr(i, j)

                Next j

                row = row + 1

            End If

        Next i

    End Sub

    代码中,将工作表Sheet4中的数据存储到数组中。然后,判断数组中第1维的值是否为“完美Excel”并复制到工作表Sheet5中。注意,数组变量必须声明为Variant型。

    使用For循环

    使用For循环,也可以实现上图3的结果。代码如下:

    Sub CopyDataByFor()

        Dim rng As Range

        Dim i As Long

        Dim j As Long

        Dim row As Long

        Set rng = Sheet4.Range("A1").CurrentRegion

        row = 1

        For i = 1 To rng.Rows.Count

            If rng(i, 1).Value = "完美Excel" Then

                For j = 1 To rng.Columns.Count

                    Sheet5.Cells(row, j).Value =rng(i, j).Value

                Next j

                row = row + 1

            End If

        Next i

    End Sub

    使用自动筛选

    使用自动筛选,不必使用很多次循环,也能实现上图3所示的结果。代码如下:

    Sub CopyDataByAutoFilter()

        Dim rng As Range

        Set rng = Sheet4.Range("A1").CurrentRegion

        '删除已存在的筛选

        rng.AutoFilter

        '应用自动筛选

        rng.AutoFilter Field:=1, Criteria1:="完美Excel"

        '复制数据

        Sheet4.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy

        Sheet5.Range("A1").PasteSpecialxlPasteValues

        '删除筛选

        rng.AutoFilter

    End Sub

    使用高级筛选

    高级筛选能够直接将满足条件的数据复制到指定的位置,但需要先指定条件。如下图4所示,工作表Sheet10中的单元格区域A1:B7为数据区域,单元格区域D1:D2为筛选条件,需要筛选出名称为“完美Excel”的数据至工作表Sheet11中。

    a7cb626b566279457b3a258b7b25e166.png

    图4

    代码如下:

    Sub CopyDataByAdvancedFilter()

        Dim wksData As Worksheet

        Dim wksFilter As Worksheet

        Dim rngData As Range

        Dim rngCriteria As Range

        Set wksData =ThisWorkbook.Worksheets("Sheet10")

        Set wksFilter =ThisWorkbook.Worksheets("Sheet11")

        '清空要放置复制数据的工作表

        wksFilter.Cells.Clear

        '删除已存在的筛选

        If wksData.FilterMode = True Then

            wksData.ShowAllData

        End If

        '获取数据区域

        Set rngData =wksData.Range("A1").CurrentRegion

        '条件区域

        Set rngCriteria =wksData.Range("D1:D2")

        '筛选并获取满足条件的数据

        rngData.AdvancedFilterAction:=xlFilterCopy, _

            CriteriaRange:=rngCriteria, _

           CopyToRange:=wksFilter.Range("A1")

    End Sub

    运行代码后的结果如下图5所示。

    9ca2142fc902769ec96ef657d7c9cf9d.png

    图5

    高级筛选还可以处理多个条件,对于同一行中的条件关系为“AND”,对于不同行中的条件关系为“OR”。

    提示

    1. 在使用VBA代码进行复制操作时,我们不需要先选择想要复制的数据,也不需要选择或激活数据所在的工作表。

    2. 在不同的工作表之间复制,或者在不同的工作簿之间复制时,在前面加上相应的工作表或工作簿名称。

    3. 在复制前关闭Excel的某些功能,可以加速复制操作。一般,在复制代码前,使用下面的代码关闭相关的功能:

    Application.Calculation =xlCalculationManual

    Application.DisplayStatusBar =False

    Application.EnableEvents =False

    Application.ScreenUpdating =False

    在复制代码完成后,再恢复相关的功能:

    Application.Calculation =xlCalculationAutomatic

    Application.DisplayStatusBar =True

    Application.EnableEvents = True

    Application.ScreenUpdating =True

    相关文章链接:

    Excel VBA解读(49):复制或剪切单元格——Copy方法与Cut方法

    Excel VBA解读(52):自动筛选方法——AutoFilter方法

    Excel VBA解读(53):高级筛选——AdvancedFilter方法

    9de08f687ef09d77601ca5dc1773f2e6.png

    展开全文
  • Excel表格中使用VBA代码去重数据

    千次阅读 2021-02-20 14:41:48
    Range("a2:a21").Copy [D1] '将[a2:a21]数据复制粘贴到D列 [D:D].RemoveDuplicates Columns:=1 '对D列数据请将去重操作 End Sub 2.使用数组方式直接去重 Sub 数组去重() On Error Resume Next Dim arr1() arr = ...

    数据源,如图1-1所示
    数据源
    如图1-2所示,通过几种方式去重后得到的效果,具体代码请看后面代码
    去重后得到的效果

    1.借助辅助项去重

    Sub 借助辅助列去重()
    Range("a2:a21").Copy [D1]  '将[a2:a21]数据复制粘贴到D列
    [D:D].RemoveDuplicates Columns:=1 '对D列数据请将去重操作
    End Sub
    

    2.使用数组方式直接去重

    Sub 数组去重()
    On Error Resume Next
    Dim arr1()
    arr = Range("A2:A21")
    ReDim arr1(1 To UBound(arr))
    For i = LBound(arr) To UBound(arr)    'LBound和UBound 分别是数组的下限和上限
        n = WorksheetFunction.Match(arr(i, 1), arr1, 0)
        If n = "" Then
            x = x + 1
            arr1(x) = arr(i, 1)
        End If
        n = ""
    Next i
    '上面代码已经得到结果,后面的代码作用就是将结果展现,可以不要'
    For j = 1 To UBound(arr1)
    Debug.Print arr1(j) '这一步可以将数据在立即窗口展示
    Range("E" & j + 1) = arr1(j)'这步骤将数组内容依次放到E列,'
    Next j
    MsgBox Join(arr1) '使用Msgbox信息框将数组内容展示,其中jion函数是将arr1数组中的字符串依次合并连接'
    End Sub
    

    3.使用字典去重

    Sub 字典去重1()
    On Error Resume Next
    'Dim dic1 As New dictionary 如果要是使用这段代码的话  需要前期绑定,否则使用后面一条代码实现后期绑定
    Set dic1 = CreateObject("scripting.dictionary") 
    arr1 = Range("A2:A21")
    For i = 1 To UBound(arr1)
        dic1.Add arr1(i, 1), ""
    Next i
    tem = dic1.keys
    '上面代码已经得到结果,后面的代码作用就是将结果展现,可以不要'
    For j = 0 To UBound(tem)
    Debug.Print tem(j) '这一步可以将数据在立即窗口展示
    Range("F" & j + 2) = tem(j) '这步骤将数组内容依次放到F列,'
    Next j
    End Sub
    
    Sub 字典去重2()
    'Dim dic1 As New dictionary 如果要是使用这段代码的话  需要前期绑定,否则使用后面一条代码实现后期绑定
    Set dic1 = CreateObject("scripting.dictionary") 
    arr1 = Range("A2:A21")
    For i = 1 To UBound(arr1)
        dic1(arr1(i, 1)) = "" '对关键字的条目进行修改,如果字典没有该关键字,则写入,否则就修改关键字条目
    Next i
    tem = dic1.keys
    '上面代码已经得到结果,后面的代码作用就是将结果展现,可以不要'
    For j = 0 To UBound(tem)
    Debug.Print tem(j) '这一步可以将数据在立即窗口展示
    Range("G" & j + 2) = tem(j) '这步骤将数组内容依次放到G列,'
    Next j
    End Sub
    

    @Ar.彭超
    很久没登录账号了,今天才看到。
    关于你问的问题 我就在这里给你回答一下,
    关于将得到的数据存储到不同工作薄的制定位置,只需要将原有的数据的存储位置更改一下就好了。
    rang()表达式当前工作薄的当前工作表,前面省略了前缀工作簿和工作表。如果需要存储到不同的工作薄或者工作表,只需要将对于的工作薄和工作表换成你需要存储的工作薄和工作表的名称。下面我就来举例一下
    下面代码以字典去重2的代码来修改
    1.将得到的数据存储到指定工作薄的表格(工作薄不存在的情况,需要新建)。
    关键要点:workbooks.add 新建工作薄
    workbooks.SaveAs 工作薄保存到指定文件路径
    添加了********的行的代码就是新添加的代码

    Sub 字典去重并保存到新建工作薄()
    Dim dic1 As Object '
    Dim arr1, tem
    Dim i%, j%
    Dim ws As Worksheet '********
    Dim wb As Workbook '********
    Set wb = Workbooks.Add '新建工作薄,并且赋值给wb ********
    Set ws = wb.Sheets(1) '将wb工作薄的第一张sheets表赋值给ws********
    Set dic1 = CreateObject("scripting.dictionary")
    arr1 = Range("A2:A21")
    For i = 1 To UBound(arr1)
        dic1(arr1(i, 1)) = "" '对关键字的条目进行修改,如果字典没有该关键字,则写入,否则就修改关键字条目
    Next i
    tem = dic1.keys
    '上面代码已经得到结果,后面的代码作用就是将结果展现,可以不要'
    For j = 0 To UBound(tem)
    Debug.Print tem(j) '这一步可以将数据在立即窗口展示
    ws.Range("A" & j + 2) = tem(j) '将得到的数据保存到ws表格中********
    Next j
    wb.SaveAs "C:\Users\Administrator\Desktop\工作簿3.xlsx" '将表格另存到指定工作路径’********
    wb.Close '关闭wb工作薄
    End Sub
    

    2.将得到的数据存储到指定工作薄的表格(工作薄已存在的情况,不需要新建)。
    关键要点:workbooks.open’打开已有工作薄
    workbooks.close True‘关闭工作薄,并保存修改内容’
    添加了********的行的代码就是新添加的代码

    Sub 字典去重并保存到已有工作薄()
    Dim dic1 As Object '
    Dim arr1, tem
    Dim i%, j%
    Dim ws As Worksheet '********
    Dim wb As Workbook '********
    Set wb =Workbooks.Open("C:\Users\Administrator\Desktop\工作簿1.xlsx") '将工作薄1赋值给wb ********
    Set ws = wb.Sheets(1) '将wb工作薄的第一张sheets表赋值给ws********
    Set dic1 = CreateObject("scripting.dictionary")
    arr1 = Range("A2:A21")
    For i = 1 To UBound(arr1)
        dic1(arr1(i, 1)) = "" '对关键字的条目进行修改,如果字典没有该关键字,则写入,否则就修改关键字条目
    Next i
    tem = dic1.keys
    '上面代码已经得到结果,后面的代码作用就是将结果展现,可以不要'
    For j = 0 To UBound(tem)
    Debug.Print tem(j) '这一步可以将数据在立即窗口展示
    ws.Range("A" & j + 2) = tem(j) '将得到的数据保存到ws表格中********
    Next j
    wb.Close True '关闭wb工作薄,保存对工作薄的更改********
    End Sub
    
    展开全文
  • VBA操作网页读取数据自动填入EXCEL表
  • VBA跨表复制

    2020-12-01 16:29:32
    & 3 + aa).Select Selection.Copy Windows("工作簿3").Activate Range("Y" & 17 + aa).Select ActiveSheet.Paste Next End Sub '不同单元格的合并在excel界面用&,在vba界面用and; '可以用Mid函数进行文本的提取

    Sub Macro1()
    '
    ' Macro1 Macro
    ' 宏由 Administrator 录制,时间: 2020/12/01
    '

    '
    Dim aa As Integer
    For aa = 0 To 19
    Application.ScreenUpdating = False '避免屏幕刷新,不好看
        Windows("参会报告.xlsx").Activate
        Range("F" & 3 + aa).Select
        Selection.Copy
        Windows("工作簿3").Activate
        Range("B" & 17 + aa & ":K" & 17 + aa).Select
        ActiveSheet.Paste
        
       '这两行是合并代码 一般不要启用,比较卡
       ' Range("Q" & 17 + aa & ":S" & 17 + aa).Select
       ' Selection.Merge Across:=False
       
       Windows("参会报告.xlsx").Activate
        Range("C" & 3 + aa).Select
        Selection.Copy
        Windows("工作簿3").Activate
        Range("T" & 17 + aa & ":W" & 17 + aa).Select
      
        ActiveSheet.Paste
       
        Windows("参会报告.xlsx").Activate
        Range("J" & 3 + aa).Select
        Selection.Copy
        Windows("工作簿3").Activate
        Range("X" & 3 + aa).Select
        ActiveSheet.Paste
        
        Windows("参会报告.xlsx").Activate
        Range("E" & 3 + aa).Select
        Selection.Copy
        Windows("工作簿3").Activate
        Range("L" & 17 + aa & ":P" & 17 + aa).Select
        ActiveSheet.Paste
        
        Windows("参会报告.xlsx").Activate
        Range("H" & 3 + aa).Select
        Selection.Copy
        Windows("工作簿3").Activate
        Range("Y" & 17 + aa).Select
        ActiveSheet.Paste
        
    Next
    End Sub

    '不同单元格的合并在excel界面用&,在vba界面用and;

    '可以用Mid函数进行文本的提取

    展开全文
  • Table_i As Integer '当前DOC中表格个数,表格序数 Dim r, c, i, CellsR, CellsC As Integer '提取表格数据时需要的行号变量,列号变量,记录用数组的位置变量,Excel的行列序号 Set WordDOC = CreateObject(...
  • ES)) ‘’清除表格中的一些无效字符,比如回车换行等:WorksheetFunction.Clean( ) next mCell 以上代码遍历某个表格中的所有单元格。 而 For Each mTable In mDoc.tables 是遍历文档所有的表格
  • [vb]代码库'把当前Excel工作簿的所有工作表的数据表格转换为Insert语句并导入SQL Server数据库。Option ExplicitPublic Sub CreateAllSheetsInsertScript()On Error GoTo ErrorHandler 'recordset and connection ...
  • 因此,例如,它需要复制Myworkbook book的Sheet2数据,并将其粘贴到他们的工作簿Sheet2的范围内 . 范围和工作表编号信息存储在单独工作簿的位置 .编辑:我添加了一张wbOpen的图片 . This is it here.Op...
  • VBA复制Excel数据速度过慢解决方法 在使用VBA语句实现对Excel文件自动化处理过程,当所操作的数据量很大时,会发现程序执行起来很慢,而且Excel文件中行数越多,速度越慢,这时除了改进程序,编写得更加高效方法外...
  • VBA之合并多个表格数据

    千次阅读 2020-03-26 21:36:12
    有很多的工作表,如何把它们合并到sheet1里呢? 代码如下 Sub hebing() Dim i, j As Integer 'i是数据源表的最后一行,j是目标表(数据表)的最后一行 ...'复制表头 Sheet2.Range(“a1:f1”).Copy ...
  • 1、将总表根据【销售部门】拆分成不同表格 2、拆分后保持格式不变 拆分前 总表 拆分后 表结构 一部 二部 七部 代码如下 Sub cfgzb() '拆分工作表 Dim i As Integer, endrow As Integer, irow As ...
  • VBa代码,用此代码可以从未打开的文件读取您所需要的数据
  • VBA 复制粘贴很多数据比较慢怎么办

    千次阅读 2020-08-26 23:59:35
    VBA复制几十万行太慢怎么办?怎么提升效率其实之前讲过啦~ 比如创建一个20万行*20列的数据复制到另一张表,怎么样创建比较快呢? 要是想着循环20万次,每次都赋值一次到单元格,那可就太慢了,最好就是先循环...
  • 如何将excel表格中大量数据导入matlab并作图工具:MATLAB、office excel将待导入的矩阵结构据录入Excel,录入时注意行列原矩阵一一对应。录入完以后保存数据,为了后续步骤使用方便,命名时最好把它命名为接下来...
  • 股票代码 昨日收盘 今日收盘 000001 23.02 24.53 000002 34.53 37.54 000003 8.65 8.12 000004 3.45 3.47 000005 12.05 13.23 000006 32.56 32.56 000007 15.65 15.78 编写VBA程序,从该文本文件读入数据到Excel...
  • 写在前面:本次分享出的内容,您真的非常值得研究。 对于将Excel里面的内容传送至Word的...此部分人的工作流程特点是:在EXCEL里面做好数据分析,然后再把这些内容搬到Word里面,形成最终的文字性报告。 常规的做法...
  • 打开给定工作簿,选择按钮,输入你需要在多个表格中复制数据位置(可以为空),但是切记,第一行和第一列不能为空和最短的数据,否则会被覆盖掉,因为是根据第一行和第一列的长度来判断并向后依次追加数据(按行按...
  • 将EXCEL表格导入CADVBA源代码

    热门讨论 2011-07-19 19:06:38
    将EXCEL表格导入CADVBA小程序 1、能识别EXCEL表格单元格格式和合并单元格; 2、能设字高比,并保证字在表格内;
  • " , '" & Sheets(1).Cells(i, j) & "'" Next j Sql = Sql & ")" Set y = x.Execute(Sql) Next i End Sub 刚才那段有问题,用这个 在导入之前要在 我的电脑》控制面板》管理工具》数据源 里创建一个名称为A的与SQL的...
  • 看着标题估计会有点乱,下面我们以图文的方式来和大家说明,本例子要实现的最终结果!...现在,我们要做的就是,要把这X个工作薄的Sheet1这个工作表里面的数据复制了之后,粘贴到“合并数据.xls”这个工...
  • 通过VBA将word表格导入到excel

    万次阅读 2018-04-09 15:43:41
    通过VBA将word表格导入到excel 由于项目需要,需要将word表格按照格式导入到excel,所以通过在wordVBA程序的方式将word的内容导出到excel。1、添加“开发工具”选项卡 打开word(我的是office...
  • 经过不懈的催促终于将考勤数据报送齐全了,接下来就是逐个统计表进行打开,复制其考勤数据,粘贴到汇总表。 关键技术点:Workbooks.Open 这个函数有许多的参数,但是大多数的应用都不会用到,如果有特殊情况用到的...
  • office应用程序是可以相互访问的,比如可以把excel的数据导出到word step1: 首先要引用word工程对象,在excelvba中依次点击 工具——》引用——》...vba从excel导出表格数据和图表到新word文档" title="exce
  • 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") ...
  • vba实现粘贴复制功能

    千次阅读 2021-02-06 22:22:00
    vba实现粘贴复制功能 Sub 复制粘贴() '第1种 复制粘贴的方法--利用range的copy Range("C13:C21").Copy Range("F13") '第2种 Range("C13:C21").Copy Range("F13").Select ActiveSheet.Paste End Sub 学习了几天...
  • 背景:业务给了一个大表格,里面几十万条数据,要拆分成成百上千个小表格,思来想去,vba做这件事是效率最高的。 样表数据源: 请按照这个表头在excel制作样表(最好将样表放在一个空文件夹里面) 然后调出VB编辑器...

空空如也

空空如也

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

vba不同表格中复制数据