Excel 活頁簿 : 工作表資料合併匯整 Part II

4

果編來出2017年的第一個 EXCEL 任務了,這次主要利用 EXCEL VBA 提供的 Range 與 Find 等指令,進行資料的比對,進而達到 工作表資料合併匯整 ,有需要類似功能的格友們,可以試試下面果編所寫的程式碼,如果有任何的疑問,歡迎直接利用留言的功能進行討論喔

任務概要

  1. 一個EXCEL 活頁簿 (Workbook) 有二個工作表 (Worksheet) 分別是 000 與 001
  2. 000 工作表
    1. A1 欄 : 存放著要拿來與 001 工作表中的第一列比對用的日期
    2. A2 ~ A? 欄 : 存放著要拿來與 001 工作表 A 欄 第 2 個儲存格之後比對用的名稱,如比對不到則將該名稱新增在 A 欄的最後一列(Row)
    3. B2 ~ B? 欄 : 存放著有被比對到的且要同步到 001 工作表的數字資
  3. 比對結果
    1. 比對到 : 則將 000 工作表中對應的數值,同步到 001 工作表中比對到的對應欄位中
    2. 比對不到 : 則將比對不到的日期或名稱,新增到 001 工作表中比對到的對應欄位中,並將對應的數值同步到對應的欄位中

EXCEL 活頁簿 工作表資料合併匯整

任務目標

  1. 上圖緣框 : 用工作表 000 中的 A1 欄的值與工作表 001 第一列(Row)所有欄(Columns) 進行日期的比對工作,如果比對不到結果,則將該日期新增在001工作表中的第1列最後一欄(Column),如上圖標綠色虛線框
  2. 上圖藍框 : 用工作表 000 中的 A2 ~ A? 欄的值與工作表 001 的 A2 ~ A? 進行文字的比對,如果比對不到結果,則將該文字新增在001工作表中A 欄(Column)的最後一列(Row),如上圖標藍色虛線框
  3. 上圖紅框 : 最後將是將工作表 000 對應的數值資料,同步更新到工作表001對應的儲存格(Cell)中

利用EXCEL VBA 進行 Excel 工作表資料合併匯整

操作步驟

  1. 首先按下快鍵盤快速鍵 ALT + F11,接著會開啟 Microsoft Visual Basic for Applications 視窗
  2. 接著點擊上方選單的 插入(I) > 模組(M),接著把下方的程式碼貼入程式碼的視窗中
  3. 再來按下鍵盤上的 F5 按鍵,會跳出一個巨集儲存的視窗,最後按下 執行 按鍵
Sub SyncDataBlocks()
    Application.ScreenUpdating = False
    
    Dim sCell, tCell, GCell, DCell As Range
    Dim sValue, sDate, tRange As String
    Dim SourceSheet, TargetSheet As Worksheet
    Dim LastColumn As Long
    
    Set SourceSheet = Sheets("000")
    Set TargetSheet = Sheets("001")
       
    If IsDate(SourceSheet.Cells(1, 1).Value) Then
        sDate = SourceSheet.Cells(1, 1).Value
    Else
        Exit Sub
    End If
    
    tRange = "A1:" & Split(Cells(, TargetSheet.Cells(1, TargetSheet.Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "1"
    
    Set DCell = TargetSheet.Range(tRange).Find( _
                                                What:=sDate, _
                                                LookIn:=xlValues, _
                                                Lookat:=xlPart, _
                                                SearchOrder:=xlByColumns, _
                                                SearchDirection:=xlPrevious, _
                                                MatchCase:=False _
                                              )
                                      
    If DCell Is Nothing Then
        TargetSheet.Cells(TargetSheet.Range("A1").CurrentRegion.Columns.Count).Offset(0, 1).Value = sDate
        tRange = "A1:" & Split(Cells(, TargetSheet.Cells(1, TargetSheet.Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "1"
        Set DCell = TargetSheet.Range(tRange).Find( _
                                                    What:=sDate, _
                                                    LookIn:=xlValues, _
                                                    Lookat:=xlPart, _
                                                    SearchOrder:=xlByColumns, _
                                                    SearchDirection:=xlPrevious, _
                                                    MatchCase:=False _
                                                  )
    End If
    
    For Each sCell In SourceSheet.Range("A1:A" & SourceSheet.Cells.SpecialCells(xlCellTypeLastCell).Row)
        sValue = Trim(sCell.Offset(1, 0).Value & vbNullString)
        If (sValue) = vbNullString Then Exit For
        
        Set GCell = TargetSheet.Range("A:A").Find( _
                                                    What:=sCell.Offset(1, 0).Value, _
                                                    LookIn:=xlValues, _
                                                    Lookat:=xlWhole, _
                                                    SearchOrder:=xlByRows, _
                                                    SearchDirection:=xlPrevious, _
                                                    MatchCase:=False _
                                                 )
                                                 
                                                                                                                
        If GCell Is Nothing Then
            TargetSheet.Cells(TargetSheet.Cells(TargetSheet.Rows.Count, 1).End(xlUp).Row, "A").Offset(1, 0).Value = sValue
            TargetSheet.Cells(TargetSheet.Cells.SpecialCells(xlCellTypeLastCell).Row, TargetSheet.Range("A1").CurrentRegion.Columns.Count) = sCell.Offset(1, 1).Value
        Else
            TargetSheet.Cells(Split(GCell.Address, "$")(2), Split(DCell.Address, "$")(1)) = sCell.Offset(1, 1).Value
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub
Share.

4 篇迴響

  1. VBA 耶!! 好久不見的玩意
    大概只有研究所或職場會用到
    現在領域和之前做的不同
    都忘記要如何使用了 XD

    • Hi 阿福,
      目前職場上還大都是 Microsoft Office 的天下
      只要可以幫忙自己省下每天處理重覆性工作的時間
      再加上 Office 本身就支援 VBA 了,不用再進行額外的安裝
      所以不管它有多老,個人還是會覺得很好用說,你說是吧!?

    • Hi LONDON CALLER,
      我也是好久沒玩了, 最近剛好工作上有需要
      所以就研究了一些關於如何簡化工作的題目
      有點小心得,想說拿出來跟大家分享心得

歡迎您發表迴響唷!