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

 

  • 0
    点赞
  • 3
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值