当前位置:首页 > Office > Excel > 正文内容

整理农行卡交易明细VBA

小编编4年前 (2020-12-05)Excel282

分享一个自用的整理农行卡交易明细的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


扫描二维码推送至手机访问。

版权声明:本文由别跟我这儿胡闹发布,如需转载请注明出处。

转载请注明出处:http://hunao.vip/?id=21

分享给朋友:

相关文章

随机生成12个月销售数据的VBA

Sub 随机生成全年销售数据()     Dim i, w, x, p   &nb...

备份PERSONAL.XLSB,教训呐!

如果你像我一样,个人宏文件里有好多自定义函数、宏,一定注意经常备份PERSONAL.XLSB,特别装系统之前,千万别忘了,要不真傻逼了。...

Excel自定义函数

个人经验,如果用Excel表计算工资,用VBA自定义函数要比弄公式简单的多,直接用“=管理工资(张三)”完事,如果有多个角色,像管理、车间、后勤,再加个if呗。附一个自己用的VBA参考:Public&...

发表评论

访客

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。