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

 

你可能感兴趣的:(office,VBA)