[数据]:逐月趋势速览-Vba简易窗口实现
本文最后更新于3 天前,如有版本迭代或环境切变,可告知邮箱到xianghy_m@sina.com指正修改。

今天分享一个数据处理的实用技巧,即如何利用VBA来实现我们日常制式表格的快速预览和管理。

背景:

季报、月报、周报等等,常常需要对业务和考评进行趋势跟踪和管理。为了简化这一过程,我们引入了一种较为简便的机械操作方法-Vba。

视频为方法讲解,下文为简码


Sub ProcessData()

    Dim ws As Worksheet
    Dim wsPrev As Worksheet
    Dim lastRow As Long
    Dim lastRowPrev As Long
    Dim currentRow As Long
    Dim count1 As Long, count2 As Long
    Dim sumFrom1 As Long, sumFrom2 As Long
    Dim resultRow As Long
    Dim changeCurStatus As Long, changeSeqStat As Long
    
    Dim seqStat1BValues As String
    Dim seqStat2BValues As String
    
    ' 初始化
    seqStat1BValues = ""
    seqStat2BValues = ""

    ' 假设“当期表”在“当期表”,“上期表”在“上期表”
    Set ws = ThisWorkbook.Sheets("当期表") ' 当期表
    Set wsPrev = ThisWorkbook.Sheets("上期表") ' 上期表
    ' 获取当期表的最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 获取上期表的最后一行
    lastRowPrev = wsPrev.Cells(wsPrev.Rows.Count, "A").End(xlUp).Row

    ' 初始化计数器
    count1 = 0    ' 当期1计数
    count2 = 0    ' 当期2计数
    count3 = 0    ' 上期1计数
    count4 = 0    ' 上期2计数
    sumFrom1 = 0
    sumFrom2 = 0
    countFrom1 = 0
    countFrom2 = 0

    ' 遍历当期表(当期表)的数据
    For currentRow = 2 To lastRow ' 假设从第2行开始
        ' 直接判断单元格的值是否等于数字1
        If ws.Cells(currentRow, 3).Value = "达标" Then ' 假设Cur_status在第3列
            count1 = count1 + 1
        End If
        ' 直接判断单元格的值是否等于数字2
        If ws.Cells(currentRow, 3).Value = "不达标" Then ' 假设Cur_status在第3列
            count2 = count2 + 1
        End If
    Next currentRow
    
    For currentRow = 2 To lastRowPrev ' 假设从第2行开始
        If wsPrev.Cells(currentRow, 4).Value = "达标" Then   ' 假设Cur_status在第3列
            count3 = count3 + 1
        End If
        If wsPrev.Cells(currentRow, 4).Value = "不达标" Then ' 假设Cur_status在第3列
            count4 = count4 + 1
        End If
        
        If wsPrev.Cells(currentRow, 4).Value = "从1转出" Then ' 假设Cur_status在第3列
            countFrom1 = countFrom1 + 1
        End If
        If wsPrev.Cells(currentRow, 4).Value = "从2转出" Then ' 假设Cur_status在第3列
           countFrom2 = countFrom2 + 1
        End If
        
        ' 收集 Seq_stat 为 "从1转出" 和 "从2转出" 序列值,假设Seq_stat在第4列
        If wsPrev.Cells(currentRow, 4).Value = "从1转出" Then
            seqStat1BValues = seqStat1BValues & wsPrev.Cells(currentRow, 2).Value & vbCrLf ' 假设B列是第2列
            ' 上期表收集值,换行符
        End If
        If wsPrev.Cells(currentRow, 4).Value = "从2转出" Then
            seqStat2BValues = seqStat2BValues & wsPrev.Cells(currentRow, 2).Value & vbCrLf ' 假设B列是第2列
        End If
    Next currentRow
    
    
'sumFrom1 = sumFrom1 + ws.Cells(currentRow, 3).Value ' 假设Cur_status在第3列
'sumFrom2 = sumFrom2 + ws.Cells(currentRow, 3).Value
    
        ' 输出 Seq_stat 为 "从1转出" 和 "从2转出" 对应的 B 列值
    If Len(seqStat1BValues) > 0 Then
        MsgBox "从达标中晋级名单:" & vbCrLf & seqStat1BValues
    Else
        MsgBox "当期没有Seq_stat'从达标中晋级'"
    End If

    If Len(seqStat2BValues) > 0 Then
        MsgBox "从不达标退出名单:" & vbCrLf & seqStat2BValues
    Else
        MsgBox "当期没有Seq_stat'从不达标退出"
    End If
    
    
    ' 在结果表中输出统计信息
    Set ws = ThisWorkbook.Sheets("Result") ' 假设结果输出在“Result”工作表
    resultRow = 2 ' 从第二行开始输出
    
    
    '设置列宽
    With ws.Columns("A:C").ColumnWidth = 30    '设置第一列和第二列的列宽
    End With

    ws.Cells(resultRow, 1).Value = "上期达标(人)"
    ws.Cells(resultRow, 2).Value = count3
    resultRow = resultRow + 1

    ws.Cells(resultRow, 1).Value = "当期达标(人)"
    ws.Cells(resultRow, 2).Value = count1
    resultRow = resultRow + 1

    ws.Cells(resultRow, 1).Value = "上期不达标(人)"
    ws.Cells(resultRow, 2).Value = count4
    resultRow = resultRow + 1
    
    ws.Cells(resultRow, 1).Value = "当期不达标(人)"
    ws.Cells(resultRow, 2).Value = count2
    resultRow = resultRow + 1
    
    ws.Cells(resultRow, 1).Value = "较上期从达标中晋级(人)"
    ws.Cells(resultRow, 2).Value = countFrom1
    resultRow = resultRow + 1

    ws.Cells(resultRow, 1).Value = "较上期从不达标退出(人)"
    ws.Cells(resultRow, 2).Value = countFrom2
    resultRow = resultRow + 1

    ' 计算当期和上期的变化(基于Cur_status和Seq_stat列)
    'changeCurStatus = ws.Cells(lastRow, 3).Value - wsPrev.Cells(lastRowPrev, 3).Value ' 假设Cur_status在第3列
    'changeSeqStat = ws.Cells(lastRow, 4).Value - wsPrev.Cells(lastRowPrev, 4).Value ' 假设Seq_stat在第4列

    ' 输出变化数据
    ws.Cells(resultRow, 1).Value = "达标人数变化"
    ws.Cells(resultRow, 2).Value = count1 - count3

    resultRow = resultRow + 1

    ws.Cells(resultRow, 1).Value = "不达标人数变化"
    ws.Cells(resultRow, 2).Value = count2 - count4
    resultRow = resultRow + 1

    ' 输出确认信息,包括转出数量
    MsgBox "1、请确认上期表和本期表已粘贴更新。" & vbCrLf & _
           "2、请确认往期历史记录已存储。" & vbCrLf & _
           "3、运算完成,结果为:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
           "从1类转出数量为:" & countFrom1 & ",达标人数变化:" & count1 - count3 & vbCrLf & _
           "从2类转出数量为:" & countFrom2 & ",不达标人数变化:" & count2 - count4



End Sub
文末附加内容
暂无评论

发送评论 编辑评论


				
|´・ω・)ノ
ヾ(≧∇≦*)ゝ
(☆ω☆)
(╯‵□′)╯︵┴─┴
 ̄﹃ ̄
(/ω\)
∠( ᐛ 」∠)_
(๑•̀ㅁ•́ฅ)
→_→
୧(๑•̀⌄•́๑)૭
٩(ˊᗜˋ*)و
(ノ°ο°)ノ
(´இ皿இ`)
⌇●﹏●⌇
(ฅ´ω`ฅ)
(╯°A°)╯︵○○○
φ( ̄∇ ̄o)
ヾ(´・ ・`。)ノ"
( ง ᵒ̌皿ᵒ̌)ง⁼³₌₃
(ó﹏ò。)
Σ(っ °Д °;)っ
( ,,´・ω・)ノ"(´っω・`。)
╮(╯▽╰)╭
o(*////▽////*)q
>﹏<
( ๑´•ω•) "(ㆆᴗㆆ)
😂
😀
😅
😊
🙂
🙃
😌
😍
😘
😜
😝
😏
😒
🙄
😳
😡
😔
😫
😱
😭
💩
👻
🙌
🖕
👍
👫
👬
👭
🌚
🌝
🙈
💊
😶
🙏
🍦
🍉
😣
Source: github.com/k4yt3x/flowerhd
颜文字
Emoji
小恐龙
花!
上一篇
下一篇