整理农行卡交易明细VBA
分享一个自用的整理农行卡交易明细的VBA,方便记账,有犯懒的小伙伴,可以直接拿去用。没什么复杂的,自己做一遍,录制宏,然后改改细节就可以了。
Sub 银行_整理交易明细_农行() '先取消合并居中 Range("A1:A2").Select Selection.UnMerge Columns("C:C").Select Application.CutCopyMode = False Selection.Copy Columns("D:D").Select Selection.Insert Shift:=xlToRight '把金额改为数字模式 Cells.Select Selection.Replace What:=".", Replacement:=".", LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False '把第1列的日期改格式 Dim myrange01 As Range Dim currentRange01 As Range Set myrange01 = Range("a3") Dim myrow01 As Integer, mycol01 As Integer myrow01 = ActiveSheet.UsedRange.Rows.Count mycol01 = ActiveSheet.UsedRange.Columns.Count For a = 3 To myrow01 Set currentRange01 = Cells(a, 1) Set myrange01 = Union(myrange01, currentRange01) Next a myrange01.Select Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 5), TrailingMinusNumbers:=True '选取有内容的部分 Dim myrange As Range Dim currentRange As Range Set myrange = Range("a3") Dim myrow As Integer, mycol As Integer myrow = ActiveSheet.UsedRange.Rows.Count mycol = ActiveSheet.UsedRange.Columns.Count For i = 3 To myrow For j = 1 To mycol Set currentRange = Cells(i, j) Set myrange = Union(myrange, currentRange) Next j Next i myrange.Select '筛选 Selection.AutoFilter '把借方的负数删除 ActiveSheet.Range("$A$3:$L$66").AutoFilter Field:=3, Criteria1:="<0", _ Operator:=xlAnd Range("C3").Select ActiveWindow.SmallScroll Down:=30 Range("C:C").Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.ClearContents ActiveSheet.Range("$A$3:$L$66").AutoFilter Field:=3 Range("C3").Select ActiveCell.FormulaR1C1 = "收入" '把贷方的正数删除 ActiveSheet.Range("$A$3:$L$66").AutoFilter Field:=4, Criteria1:=">0", _ Operator:=xlAnd Range("D3").Select ActiveWindow.SmallScroll Down:=30 Range("D:D").Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.ClearContents ActiveSheet.Range("$A$3:$L$66").AutoFilter Field:=4 Range("D3").Select ActiveCell.FormulaR1C1 = "支出" '取消筛选 myrange.Select Selection.AutoFilter '按日期升序重新排序,故意用了个较大的数字7000,以全部选中,暂时没有想到更好的办法。 ActiveSheet.Sort.SortFields.Clear ActiveSheet.Sort.SortFields.Add2 Key:=Range("A4:A7000") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveSheet.Sort .SetRange Range("A3:L7000") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With '加边框,改行高 myrange.Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With myrange.Select Selection.RowHeight = 24 '把支出列的数字去掉负号 Columns("D:D").Select Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False '改单元格格式为数值 Columns("C:D").Select Range("C3").Activate Selection.NumberFormatLocal = "#,##0.00_);[红色](#,##0.00)" '合并居中 Range("A1:L1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("A2:L2").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge End Sub