VBA小程序:分拆單元格內容並插入到N個列中

在小微經營貸進件過程中,要求傳入店鋪開業以來月度交易流水,在接口字段中約定以類似於[{"month": "201909", "amount": 10550}, {"month": "201908", "amount": 102757}]的形式傳入,風控專員需要從該字段中拆分出每月交易流水,並且按照月份由近及遠排列,從而方便監控店鋪經營流水的變化趨勢。

針對上述需求,用VBA來實現是再理想不過了。基本原理是定位到月度交易流水字段,並遍歷每一行,調用Split()函數將字符串拆分成數組,並調用簡單的交換排序確保按月份降序排列,最後將每月交易流水填入新增的列中。

使用方法:打開該宏文件,切換到目標excel文件,按ctrl+q(綁定的熱鍵,即執行extractMonthRevenue過程)即可。

上述用綁定熱鍵的操作方法的優點是,對目標excel文件不需要做任何變化或加工,只要有對應月交易流水字段即可(原因是vba代碼中沒有指定工作表,默認是ActiveSheet,即只要焦點在目標excel文件中即可)。


'默認抽取n個月的經營流水(通常n取12)
'Public Const NUM_MONTH As Integer = 12

'定義最大列序號,用於查詢終止條件
Public Const MAX_COLUMN As Integer = 500

'抽取月經營流水,類似於字符串[{"month": "201909", "amount": 10550}, {"month": "201908", "amount": 102757}]
Sub extractMonthRevenue()
    Dim str As String '經營流水數據
    Dim arrStr As Variant '經營流水分割成字符串數組
       
    Dim i, j, r, pos As Integer '循環變量、遊標位置
    
    Dim tmp As String '臨時變量(交換排序中用於交換兩個元素值)
    
    Dim targetCol As Integer '月度交易流水所在列序號
    
    Dim numAppendCol As Integer '新插入的列數量(用於存放每月交易流水)
    
    'MsgBox Cells(1, 1).Value
         
    '列序號初始化爲首列
    j = 1
    
    '定位月度交易流水(jsy_risk_trade_flow)所在列,默認表頭位於第一行
    Do While Cells(1, j).Value <> "jsy_risk_trade_flow" And j < MAX_COLUMN
        j = j + 1
        
        '默認表頭位於第一行
        'If Cells(1, j).Value = "jsy_risk_trade_flow" Then
        '    Exit Do
        'End If
    Loop
    
    ' 沒有月度交易流水列,則提示並退出過程
    If j = MAX_COLUMN Then
        MsgBox ("沒有月度交易流水jsy_risk_trade_flow列,請檢查工作表數據!")
        Exit Sub
    End If
    
    '保存月度交易流水列序號
    targetCol = j
    
    '初始化新插入列數量
    numAppendCol = 0
    
    '默認數據從第二行開始
    r = 2
    
    '遍歷數據行
    Do While Cells(r, targetCol).Value <> ""
            
        '從單元格獲取月經營流水,並去除頭尾大括號和花括號([{和}])
        str = Cells(r, targetCol).Value
        str = Mid(str, 3, Len(str) - 4)
        
        '切割字符爲數組
        arrStr = Split(str, "}, {")
        
        '降序排列,vba沒有針對數組排序的系統函數,自己寫個最簡單的交換排序(即最小值挪最後面)
        For i = UBound(arrStr) To 0 Step -1
            tmp = arrStr(i)    '取最後一個數
            
            '通過循環,將最小數放在本次循環內數組最後
            For j = 0 To i - 1
                If arrStr(j) < arrStr(i) Then
                    tmp = arrStr(j)
                    arrStr(j) = arrStr(i)
                    arrStr(i) = tmp
                End If
            Next j
        Next i
        
        '每月交易流水填入對應的新增列
        For i = 0 To UBound(arrStr)
            '判斷是否插入新增列
            If (i + 1) > numAppendCol Then
                Columns(targetCol + i + 1).EntireColumn.Insert
                Cells(1, targetCol + i + 1).Value = "倒數" & (i + 1) & "月"
                numAppendCol = numAppendCol + 1
            End If
            
            pos = InStr(arrStr(6), """amount"": ")
            
            '基於接口定義,月度交易流水要單位是分,除以100換算爲元
            Cells(r, targetCol + i + 1).Value = Right(arrStr(i), Len(arrStr(i)) - pos - 9) / 100
        Next i
        
        r = r + 1
    Loop
    
End Sub

 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章