整理农行卡交易明细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