在小微經營貸進件過程中,要求傳入店鋪開業以來月度交易流水,在介面欄位中約定以類似於[, ]的形式傳入,風控專員需要從該字段中拆分出每月交易流水,並且按照月份由近及遠排列,從而方便監控店鋪經營流水的變化趨勢。
針對上述需求,用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
'抽取月經營流水,類似於字串[, ]
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 '月度交易流水所在列序號
'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
'初始化新插入列數量
'預設資料從第二行開始
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)
'判斷是否插入新增列
columns(targetcol + i + 1).entirecolumn.insert
cells(1, targetcol + i + 1).value = "倒數" & (i + 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
VBA研究 如何檢測單元格內容改變
iamlaosong文 我們經常需要監督excel工作表中單元格的值是否變化,例如我們客服有乙個報表要通報,報表的內容來自很多地方,需要將這些資料複製到這個表中,由於資料較多,為了防止有遺漏,希望更新後的資料有個標誌,這樣沒有更新的就一目了然了。為此,很自然就會想起利用worksheet chang...
使用VBA程式進行單元格顏色填充
private sub worksheet selectionchange byval target as range 改變選擇單元格時執行 dim i,j,k as integer set mysheet1 thisworkbook.worksheets sheet1 for i 3 to 100...
VBA 單元格合併時內容也進行合併
一 功能 選中單元格,在進行合併時,單元格的內容也進行合併,而不只是保留左上角單元格。二 示例 sub hebing dim s as string,c as range if typename selection range then for each c in selection s s c.v...