VBA_headers_mapping

Header Mapping--应对 Report Headers 的变化

Author : Collin_PXY

背景

在 RPA工作中，稳定的规则非常重要，因为 RPA项目就是基于规则而进行的，但规则有时候也会发生变化，而且有时候这种变化是在开发阶段无法预料的，此时，对于我们已经在使用当中的 Robots来说，就有可能会导致 Robots运行失败。因此，在维护阶段需要对变化的规则进行补救性应对，尤其是当变化的规则影响面很大的时候，就要采用一种代价最小，风险最低的方案来。

案例

该案例启发于真实项目，业务逻辑中所需要的一个重要的 report的headers发生了重大变化，headers的名称及位置都发生了变化，此时对业务逻辑来讲是灾难性的，此时负责维护的团队需要在较短的时间内来解决这个问题。Header Mapping 就是一种解决方案：

1-设计阶段的 report headers layout:

2-发生变化之后的 report headers layout:

3-需求：

业务中不需要的headers不需要改动，没有发生变化的headers也不需要改动，业务中需要的且发生变化的headers要把名称及位置转化为 report变化之前的样子。

4-方案设计：

1）Header Mapping表的设计：（根据业务需要设计）

2）代码设计：

Option Explicit
Option Base 1

Sub HeaderMapping()
    On Error GoTo errorhandling
    Dim wb                  As Workbook
    Dim wb_output           As Workbook
    Dim rng                 As Range
    Dim usedrows            As Integer
    Dim usedcolumns         As String
    Dim report_path         As String
    Dim output_report_path  As String
    Dim headers_dict        As Object
    Dim sht_temp            As Worksheet
   
    displayOFF
    Set headers_dict = CreateObject("Scripting.Dictionary")
    
    report_path = "C:Users12078DesktopUIPATH_testheader mapping
eport.xlsx"
    output_report_path = "C:Users12078DesktopUIPATH_testheader mappingoutput_report.xlsx"

    'Get a copy of report and saved as a new one.
    FileCopy report_path, output_report_path

    Set wb = checkAndAttachWorkbook(report_path)
    Set wb_output = checkAndAttachWorkbook(output_report_path)
    wb_output.Worksheets.Add(After:=Worksheets(1)).Name = "Temp"
    Set sht_temp = wb_output.Worksheets("Temp")

    usedrows = getLastValidRow(ThisWorkbook.Worksheets("Header Mapping"), "A")
    For Each rng In ThisWorkbook.Worksheets("Header Mapping").Range("A2", "A" & usedrows)
        If Not headers_dict.exists(rng.Offset(0, 2).Value) Then
            headers_dict.Add rng.Offset(0, 2).Value, rng.Value
        End If
    Next rng
    
    'Rename the headers
    usedcolumns = getLastValidColumn(wb_output.Worksheets(1), 1)
    For Each rng In wb_output.Worksheets(1).Range("A1", usedcolumns & 1)
        If headers_dict.exists(rng.Value) Then
            rng.Value = headers_dict(rng.Value)
        End If
    Next
    
    'Sort the headers
    For Each rng In ThisWorkbook.Worksheets("Header Mapping").Range("B2", "B" & usedrows)
        If VBA.Trim(rng.Value) <> VBA.Trim(rng.Offset(0, 2).Value) Then
            Call sortHeaders(wb_output.Worksheets(1), sht_temp, Convertcolumntonumber(VBA.Trim(rng.Value)), _
            Convertcolumntonumber(VBA.Trim(rng.Offset(0, 2).Value)))
        End If
    Next rng

    sht_temp.Delete
    checkAndCloseWorkbook report_path, False
    checkAndCloseWorkbook output_report_path, True
    
Exit Sub
errorhandling:
    checkAndCloseWorkbook report_path, False
    checkAndCloseWorkbook output_report_path, False
End Sub
    
Function sortHeaders(sht As Worksheet, temp_sht As Worksheet, ByVal right_col_index As Byte, ByVal to_be_sorted_col_index As Byte)
    
    sht.Activate
    sht.Columns(right_col_index).Select
    Selection.Cut
    temp_sht.Activate
    temp_sht.Columns(1).Select
    ActiveSheet.Paste
    
    sht.Activate
    sht.Columns(to_be_sorted_col_index).Select
    Selection.Cut
    sht.Columns(right_col_index).Select
    ActiveSheet.Paste
    
    temp_sht.Activate
    temp_sht.Columns(1).Select
    Selection.Cut
    sht.Activate
    sht.Columns(to_be_sorted_col_index).Select
    ActiveSheet.Paste
    
    temp_sht.Columns(1).ClearContents
    
End Function

'辅助函数
Function getLastValidColumn(in_ws As Worksheet, in_row As Integer) As String
    Dim i As Integer
    i = in_ws.Cells(in_row, Columns.count).End(xlToLeft).Column
    getLastValidColumn = ConvertColumnToAlpha(i)
End Function


'Convert column number to alpha. e.g:column 2 -> column B.
Function ConvertColumnToAlpha(ByVal num As Integer) As String
    ConvertColumnToAlpha = Replace(Cells(1, num).Address(False, False), "1", "")
End Function

'Convert column to number
Function Convertcolumntonumber(ByVal col As String) As Long
    Convertcolumntonumber = Range("a1:" & col & "1").Cells.count
End Function

'Get last row of Column N in a Worksheet
Function getLastValidRow(in_ws As Worksheet, in_col As String)
    getLastValidRow = in_ws.Cells(in_ws.Rows.count, in_col).End(xlUp).Row
End Function

Function checkAndAttachWorkbook(in_wb_path As String) As Workbook
    Dim wb As Workbook
    Dim mywb As String
    mywb = in_wb_path

    For Each wb In Workbooks
        If LCase(wb.FullName) = LCase(mywb) Then
            Set checkAndAttachWorkbook = wb
            Exit Function
        End If
    Next
    
    Set wb = Workbooks.Open(in_wb_path, UpdateLinks:=0)
    Set checkAndAttachWorkbook = wb
    
End Function

Function checkAndCloseWorkbook(in_wb_path As String, in_saved As Boolean)
    Dim wb As Workbook
    Dim mywb As String
    mywb = in_wb_path
    For Each wb In Workbooks
        If LCase(wb.FullName) = LCase(mywb) Then
            wb.Close Savechanges:=in_saved
            Exit Function
        End If
    Next
End Function

'don't allow alerts window display, or update screen
Function displayOFF()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
End Function

5-结果：

符合预期，输出结果同设计阶段的样子，图1。