Excel VBA 从一个工作簿查找另一个一个工作簿中的一些内容复制到另外一个工作簿
帮朋友来写个Excel VBA
以前写过ASP,所以对vb略微熟悉,但VBA 没有仔细研究过。
以前只研究过 vba 写一个 计算个人所得税的程序。
这次写的功能也算是简单,但也耗费了两天的功夫。
需求:
1 从【操作】表中,查找最后一行的数据,每一列 都为关键字
2 遍历这些关键字,从【总表】中查询这个关键字,把这一行后面的内容复制到 【预算】表中去
3 把【操作】中制定内容复制到【信息统计】中
- Function Get操作NullLine()
- '
- '从 操作表 获取最后一个有数据下面的空行 row 序号
- '
- Get操作NullLine = GetNullLine("操作", "A", )
- End Function
- Function Get预算NullLine()
- '
- '从 预算表 获取最后一个有数据下面的空行 row 序号
- '
- Get预算NullLine = GetNullLine("预算", "A", )
- End Function
- Function Get信息统计NullLine()
- Get信息统计NullLine = GetNullLine("信息统计", "A", )
- End Function
- Function GetNullLine(excelTable As String, fromCell As String, beginRow As Integer)
- '
- '从 excelTable表 获取[fromCell单元格开始的]最后一个无数据的空行 row 序号
- '
- '设置开始的行
- Dim line: line = beginRow
- '选择Excel工作簿
- Worksheets(excelTable).Select
- '查找空行
- For Each c In Worksheets(excelTable).Range(fromCell & beginRow & ":" & fromCell & "").Cells
- If c.Value <> "" Then
- 'With c.Font
- ' .Bold = True
- ' .Italic = True
- 'End With
- '''''''''MsgBox c.Value'查看当前是什么数据
- Else
- '找到了空行则返回
- GetNullLine = line
- Exit Function
- End If
- line = line +
- Next c
- End Function
- Sub CreateNewOrderID()
- '
- ' CreateNewOrderID 宏
- ' 创建单号
- '
- Sheets("操作").Select
- Range("Q1:U1").Select
- '单元格格式为文本即可
- Selection.NumberFormatLocal = "@"
- '设置单元格内容为 订单号,规则= 日期
- ActiveCell.FormulaR1C1 = Year(Now()) & Month(Now()) & Day(Now()) & Hour(Now()) & Minute(Now()) & Second(Now())
- End Sub
- '
- '遍历 操作表 中的一行序号,每一个序号都进行 DealSelectData(str) 处理,失败,则提示
- '
- Function DealRowDatas(n As Integer) As Boolean
- DealRowDatas = False
- If n < Then MsgBox "错误的参数 n=-1": Exit Function '判断传参错误
- If Not DealSelectData(Worksheets("操作").Range("A" & n).Value) Then MsgBox "处理这行数据错误:【" & "A" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("B" & n).Value) Then MsgBox "处理这行数据错误:【" & "B" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("C" & n).Value) Then MsgBox "处理这行数据错误:【" & "C" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("D" & n).Value) Then MsgBox "处理这行数据错误:【" & "D" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("E" & n).Value) Then MsgBox "处理这行数据错误:【" & "E" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("F" & n).Value) Then MsgBox "处理这行数据错误:【" & "F" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("G" & n).Value) Then MsgBox "处理这行数据错误:【" & "G" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("H" & n).Value) Then MsgBox "处理这行数据错误:【" & "H" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("I" & n).Value) Then MsgBox "处理这行数据错误:【" & "I" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("J" & n).Value) Then MsgBox "处理这行数据错误:【" & "J" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("K" & n).Value) Then MsgBox "处理这行数据错误:【" & "K" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("L" & n).Value) Then MsgBox "处理这行数据错误:【" & "L" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("M" & n).Value) Then MsgBox "处理这行数据错误:【" & "M" & n & "】": Exit Function
- If Not DealSelectData(Worksheets("操作").Range("N" & n).Value) Then MsgBox "处理这行数据错误:【" & "N" & n & "】": Exit Function
- DealRowDatas = True
- End Function
- '
- '根据一个字符串 比如 DM9 从总表 查询并拷贝到 预算表 中去
- '
- Function DealSelectData(str As String) As Boolean
- DealSelectData = False
- 'MsgBox "从总表中查询[" & str & "]并且添加到 预算表 中去"
- 'str= 'Range("A3").Select
- 'str= 'ActiveCell.FormulaR1C1 = "DM9"
- Sheets("总表").Select
- Dim findObj As Range
- Set findObj = Cells.Find(What:=str, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
- xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
- , MatchByte:=False, SearchFormat:=False)
- findObj.Activate
- findObj.Select
- 'MsgBox findObj.Column
- Dim findRow As Integer: findRow = findObj.Row
- '项目名称 辅材:元/单位 数量 人工:元/单位 数量 金额(元) 工艺做法及材料说明
- '拷贝以上列数据 在总表中 B-H 列的数据
- Range("B" & findRow & ":H" & findRow).Select
- Selection.Copy
- Sheets("预算").Select
- '从预算表中第几行开始粘贴
- Dim targetRow: targetRow = Get预算NullLine()
- Range("A" & targetRow).Select
- ActiveSheet.Paste
- Sheets("操作").Select
- DealSelectData = True
- End Function
- Sub Copy操作To信息统计(fromStr As String, toStr As String)
- '从一个单元格拷贝到另一个单元格
- Sheets("操作").Select
- Range(fromStr).Select
- 'MsgBox ActiveCell.Value'测试单元格是什么值
- 'ActiveCell.FormulaR1C1 = "2015215104319"
- ActiveCell.Copy
- 'Selection.Copy
- Sheets("信息统计").Select
- Range(toStr).Select
- 'ActiveSheet.Paste'此粘贴包含了格式,不好用!!!!!
- '只粘贴值,不粘贴格式
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- End Sub
- '
- '0 【增加到预算按钮】把操作表 最后一行的每一列的类似 DM9 这样的数据,从总表查询出来,拷贝到预算中去
- '
- Sub 增加到预算()
- Application.ScreenUpdating = False
- Call CreateNewOrderID
- If Not DealRowDatas(Get操作NullLine() - ) Then: MsgBox "增加到预算 失败!有错误,请联系管理员 ": Application.ScreenUpdating = True: Exit Sub
- Sheets("预算").Select
- Application.ScreenUpdating = True
- Exit Sub
- End Sub
- '
- ' 1 【保存到信息统计中】
- '
- Sub 保存到信息统计()
- Application.ScreenUpdating = False
- Dim emptyLineNo: emptyLineNo = Get信息统计NullLine()
- '单号
- Call Copy操作To信息统计("Q1:U1", "A" & emptyLineNo)
- '预算员
- Call Copy操作To信息统计("Q6:U6", "B" & emptyLineNo)
- '业主姓名
- Call Copy操作To信息统计("Q2:U2", "C" & emptyLineNo)
- '联系方式
- Call Copy操作To信息统计("Q3:U3", "D" & emptyLineNo)
- '家庭地址
- Call Copy操作To信息统计("Q4:U4", "E" & emptyLineNo)
- '施工地址
- Call Copy操作To信息统计("Q5:U5", "F" & emptyLineNo)
- Sheets("操作").Select
- Application.CutCopyMode = False
- Sheets("信息统计").Select
- Application.ScreenUpdating = True
- Exit Sub
- End Sub
Excel VBA 从一个工作簿查找另一个一个工作簿中的一些内容复制到另外一个工作簿的更多相关文章
- ZeroMQ接口函数之 :zmq_msg_copy - 把一个消息的内容复制到另一个消息中
ZeroMQ 官方地址 :http://api.zeromq.org/4-1:zmq_msg_copy zmq_msg_copy(3) ØMQ Manual - ØMQ/3.2.5 Name zm ...
- C++将一个vector中的内容复制到另一个vector结尾
在使用vector容器的时候,需要将一个vector中的内容复制到另一个vector结尾,如何实现呢? 使用vector的insert方法 template <class InputIterat ...
- C语言:写一函数,将两个字符串中的元音字母复制到另一个字符串,然后输出
题目描述 写一函数,将两个字符串中的元音字母复制到另一个字符串,然后输出. 输入 一行字符串 输出 顺序输出其中的元音字母(aeiuo) 样例输入 abcde 样例输出 ae 编码: #include ...
- java把一个文件的内容复制到另外一个文件
/** * java把一个文件的内容复制到另外一个文件 */import java.io.File;import java.io.FileInputStream;import java.io.File ...
- Linux将一个文件夹或文件夹下的所有内容复制到另一个文件夹
Linux将一个文件夹或文件夹下的所有内容复制到另一个文件夹 1.将一个文件夹下的所有内容复制到另一个文件夹下 cp -r /home/packageA/* /home/cp/packageB ...
- Java 把一个文本文档的内容复制到另一个文本文档
src.txt放在工程目录下,dest.txt可创建,也可不创建.一旦运行程序,如果dest.txt不存在,将自行创建这个文本文档,再将src.txt中的内容复制到dest.txt import ja ...
- 两个表,一个表中的两列关联另一个表的id,如何将这个表中的两列显示为另一个表id对应的内容
表A name user owner machine1 1 2 machine2 3 4 表B userid username 1 aaa 2 bbb 3 ccc 4 ddd 以上两个表,表A 设备的 ...
- SQL Server 将一个表中字段的值复制到另一个表的字段中
具体方法如下 一:update 表2 set (要插入的列名)= select 表1.某一列 from 表1 left jion 表2 on 表1和表2的关联 where ..... 二:update ...
- FileOutputStream将从一个文件中读取的内容写到另一个文件中
package com.janson.day2018082 import java.io.FileInputStream; import java.io.FileNotFoundException; ...
随机推荐
- Django 浏览器打开警告Not Found: /favicon.ico (转)
Django 浏览器打开警告Not Found: /favicon.ico 初学Django 执行python manage.py runserver 0.0.0.0:8000 urls.py ...
- linux 输入设备驱动
<输入子系统简介> a:背景 内核的输入子系统是对“分散的”,“多种不同类别”的输入设备(键盘,鼠标,跟踪杆,触摸屏,加速度计等)进行“统一处理”的驱动程序.具有如下特点: a-1:统一各 ...
- 20172308《Java软件结构与数据结构》第四周学习总结
教材学习内容总结 第 6 章 列表 一. 列表集合 列表集合:一种概念性表示法,思想是使事物以线性列表的方式进行组织 特点: 列表集合没有内在的容量大小,它可以随着需要而增大 列表集合更具一般化,可以 ...
- hdu 5726 GCD 暴力倍增rmq
GCD/center> 题目连接: http://acm.hdu.edu.cn/showproblem.php?pid=5726 Description Give you a sequence ...
- ios优秀的第三方框架
1.数据请求,object-c AFNetworking 网址:https://github.com/AFNetworking/AFNetworking swift Alamofire 网址:h ...
- 两个div如何并列 (转)
两个div如何并列?当用到div+css代替table时,我习惯用两个方法: 1 <div id="parent"> <div id="child_1& ...
- ORM for Net主流框架汇总与效率测试
框架已经被越来越多的人所关注与使用了,今天我们就来研究一下net方面的几个主流ORM框架,以及它们的效率测试(可能会有遗漏欢迎大家讨论). ORM框架:Object/Relation Mapping( ...
- POJ 1743 Musical Theme (字符串HASH+二分)
Musical Theme Time Limit: 1000MS Memory Limit: 30000K Total Submissions: 15900 Accepted: 5494 De ...
- LPC43xx State Configurable Timer : SCT
- IAR EWAR 内联汇编 调用外部函数 Error[Og005], Error[Og006]
How do I call a C function in another module from inline assembler in IAR EWARM? I have a bit of ass ...