vba中实现每日充值额度的筛选

Option Explicit

Sub 每日充值()
'要使用excel中的vba，而不能用wps！

Dim i%, j%, k%, fname$, l%
Dim r As Range, r1 As Range, b As Workbook, r2 As Range
Dim last, money
'
'last代表最后一天，money代表充值最低额度
last = 3
money = 888

'

For i = 1 To last
    fname = i & ".csv"
    Set b = Workbooks.Open("C:\Users\admin\Desktop\" & fname)
    b.SaveAs Filename:="C:\Users\admin\Desktop\" & i, FileFormat:=xlWorkbookNormal
    b.Close
Next i


'分别打开所有的活动期间充值的数据表
For i = 1 To last
    fname = i & ".xls"
    Set b = Workbooks.Open("C:\Users\admin\Desktop\" & fname)
    b.Activate
    Set r = b.Worksheets(1).UsedRange
    'r.Row.Interior.Color = vbYellow
    For j = 2 To r.Row + r.Rows.count - 1
        For k = 1 To r.Column + r.Columns.count - 1
            If b.Name <> "1.xls" Then
              Range(Cells(2, 1), Cells(j, k)).Select
            End If
        Next k
    Next j
Next i
'把其他数据表中第二行开始的数据全部汇总到第一张表前面
'把第二,第三，第四张表中第二行开始的数据从最后一行的下一行开始汇总到第一张表

For i = 2 To last
                Windows(i & ".xls").Activate
                Selection.Copy
                Windows("1.xls").Activate
                Set r2 = ActiveSheet.UsedRange
                l = r2.Row + r2.Rows.count
                Range("A" & l).Select
                ActiveSheet.Paste
Next i
'Application.CutCopyMode = False
'关闭除汇总表窗口之外所有的表窗口
For i = 2 To last
    Windows(i & ".xls").Activate
    Windows(i & ".xls").Close
Next i
'Application.CutCopyMode = True
'按顺序删除G列，F列，A列，并把B列剪切到A列前面
Columns("G:G").Delete
Columns("F:F").Delete
Columns("A:A").Delete
Worksheets(1).Columns("B:B").Cut
Worksheets(1).Columns("A:A").Insert Shift:=xlToRight
'删除充值总金额小于888的那一整行数据

Set r2 = ActiveSheet.UsedRange
l = r2.Row + r2.Rows.count - 1

Do While l <> 1
    If Cells(l, 4) <= money Then
        Rows(l).Delete
    End If
    l = l - 1
Loop
Call 统计出现的次数
Call 字典
'自动调整列宽
 '定义一个range().sort，然后定义Key1，order1
'range()定义整个数据范围，Key1用于定义哪一列，order1定义升序Ascend或者降序Descend
Worksheets(1).Range("I:J").Sort _
Key1:=Worksheets(1).Cells(1, 10), order1:=xlDescending
    Columns("A:J").EntireColumn.AutoFit

End Sub



Sub 统计出现的次数()
Dim i%, j%, count%
i = 2

    Do While Cells(i, 4) <> ""
        j = i + 1
        Do While Cells(j, 4) <> ""
            If Cells(i, 1) = Cells(j, 1) Then
                
                Cells(i, 6) = Cells(i, 2) & " " & Cells(i, 3)
                Cells(j, 6) = Cells(j, 2) & " " & Cells(j, 3)
                Cells(i, 7) = 1
                Cells(j, 7) = 1
                
            End If
        j = j + 1
        Loop
        
    i = i + 1
 
    Loop
    '定义一个range().sort，然后定义Key1，order1
'range()定义整个数据范围，Key1用于定义哪一列，order1定义升序Ascend或者降序Descend
Worksheets(1).Range("F:G").Sort _
Key1:=Worksheets(1).Cells(1, 6), order1:=xlDescending
'自动调整列宽
    Columns("A:G").EntireColumn.AutoFit
End Sub

Sub 字典()
    Dim i%, j%, k$, zd As Object
    Set zd = CreateObject("scripting.dictionary")
'循环扫描全部数据
    i = 1
            Do While Cells(i, 6) <> ""
            '把品名内容取出放到k
            k = Cells(i, 6)
                '如果品名已经存在，则执行累加
                If zd.exists(k) Then
                    zd.Item(k) = zd.Item(k) + Cells(i, 7).Value
                Else
                '不存在就新创建一个品名及其相对应的值
                    zd.Add k, Cells(i, 7).Value
                End If
            i = i + 1
            Loop
    '把所有字典元素的个数，即品名个数赋值给i
    j = zd.count
    If j > 0 Then
        Range(Cells(1, 9), Cells(j, 9)) = Application.Transpose(zd.keys())
        Range(Cells(1, 10), Cells(j, 10)) = Application.Transpose(zd.items())
    End If
    
End Sub