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