Excel VBA 从一个工作簿查找另一个一个工作簿中的一些内容复制到另外一个工作簿

 

帮朋友来写个Excel VBA

以前写过ASP，所以对vb略微熟悉，但VBA 没有仔细研究过。

以前只研究过 vba 写一个 计算个人所得税的程序。

这次写的功能也算是简单，但也耗费了两天的功夫。

需求：

1 从【操作】表中，查找最后一行的数据，每一列 都为关键字

2 遍历这些关键字，从【总表】中查询这个关键字，把这一行后面的内容复制到 【预算】表中去

3 把【操作】中制定内容复制到【信息统计】中

Function Get操作NullLine()
\'
\'从 操作表 获取最后一个有数据下面的空行 row 序号
\'
   Get操作NullLine = GetNullLine("操作", "A", 2)
End Function

Function Get预算NullLine()
\'
\'从 预算表 获取最后一个有数据下面的空行 row 序号
\'
    Get预算NullLine = GetNullLine("预算", "A", 5)
End Function

Function Get信息统计NullLine()
    Get信息统计NullLine = GetNullLine("信息统计", "A", 2)
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 & "999").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 + 1
    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 < 0 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() - 1) 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