【Tidyverse优雅编程】办公自动化：Excel考勤表清洗与两种汇总

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

给大家展示一个tidyverse优雅数据思维编程的案例。想要学习R 语言 tidyverse优雅编程，只需要下载学习我的免费课件[学习分享] 张敬信：分享我的1393页《R语言编程：基于tidyverse》完整课件

---

1 问题描述

问题来自好友 @楚新元 实际的工作场景，稍有改编：

某单位有如下 Excel 格式记录的员工考勤表（姓名是随机编造的），只截取一部分，共有 265 名员工，按 12 个月份记录了缺勤情况：

实际数据往往存在：

• 描述同一件事用词却不同、格式不同
• 记录形式多是文本，其中文字、数值、单位混杂，不能直接用于汇总计算
  

在数据操作之外，这些都需要做一定的文本处理，而文本处理又几乎肯定用到正则表达式。

本问题想要得到两种汇总结果：

• 每个员工的出勤记录的文字描述汇总（不能直接按行合并，因为需要修正描述不一致）
• 针对不同的缺勤，以及缺勤惩罚方式（扣钱），计算每个员工的扣发金额
  

下面来逐步解决问题。

先加载包：

1. library(tidyverse)
   
2. library(readxl)
   
3. libary(writexl)

复制代码

2 数据清洗

2.1 数据读取与重塑

显然这是一个不整洁的宽表，先读取数据、做长变宽，同时设置两个额外参数以忽略缺失值、从原列名解析出数值（月份）：

1. data = read_xlsx("data.xlsx") %>%   
   
2.   pivot_longer(-姓名, names_to = "月份", values_to = "事项",               
   
3.                      values_drop_na = TRUE, names_transform = parse_number)

复制代码

可以看到，事项列有的单元格记录了多件事情，其实不止、分割，还有用， ； 分割。需要将这种多条记录，切分成多行的单条记录，用 separate_rows() 即可：

1. df = data %>%   
   
2.     separate_rows(value, sep = "，|、|；")
   
3. df

复制代码

现在数据表面看起来是整洁数据了。

2.2 文本数据处理

这步需要业务逻辑，发现记录中的不一致问题，具体问题具体分析解决。

首先，事项中包含两个信息：事项、天数，但也有特殊的，比如有 全月病假、全月产假，其后不带“数字天”，注意也不是都带“假”字，有居家办公、居家隔离办公其后带“数字天”。

从貌似没有规律的文本中，发现并表达规律，就需要用到正则表达式。

有两种处理思路，一种是用两次 str_extract() 分别提取两个信息 ；一种是直接用 extract() (类似分组捕获）同时提取两个信息，这里选择后者。

extract()的基本语法是，提供对哪列做提取，提取出来作为哪几列，最主要的是正则表达式设计，用的 ()分组语法，位于其中的是要提取的部分：一个或多个非数值即汉字，数字加多个任意字符或者结尾。 这里的关键是，有的事项里不带“数字天”，所以必须要有 |$ （或者结尾），否则会牵连到整个正则表达式无法正确的匹配。

接着，天数列中包含“天”等，修改列解析成数值，解析失败的将变成 NA，正好对应原事项中不包含“数字天”的，也正好对应“全月...” 。那么全月，就需要计算该月的天数插补上，为此，先自定义一个小函数（来自楚新元，我本来是自己写代码计算，用他这个更简洁）根据年月计算当月天数。

1. # 自定义函数根据年月计算当月天数
   
2. mdays = function(month, year = 2022) {
   
3.   x = str_c(year, "-", month, "-01")
   
4.   lubridate::days_in_month(x)
   
5. }
   
6. 
   
7. df = df %>%
   
8.   extract(事项, into = c("事项", "天数"), regex = "(\\D+)(\\d.*|$)") %>%
   
9.   mutate(天数 = parse_number(天数),
   
10.          天数 = ifelse(is.na(天数), mdays(月份), 天数))
    
11. df

复制代码

再次，对于 事项 列，有很多同一事项的不同表示，需要做一定的归并：

1. df %>% count(事项)

复制代码

比如，年休，休假，都归到年休假。这属于多分支重新编码，借助 case_when() 来实现：

1. df = df %>% mutate(
   
2.     事项 = case_when(str_detect(事项, "年休|休假") ~  "年休假",
   
3.          str_detect(事项, "居家") ~  "居家",
   
4.          str_detect(事项, "病假") ~  "病假",
   
5.         str_detect(事项, "产假") ~  "产假",
   
6.         TRUE ~ 事项))
   
7. df

复制代码

注意到，同一名员工，同一种事项，可能有多次，先加以汇总：

1. df = df %>%
   
2.     group_by(姓名, 事项) %>%
   
3.     summarise(天数 = sum(天数), .groups = "drop")

复制代码

至此，数据清洗完成，后续无论做何种汇总，都已经非常方便。

3 汇总1：按员工汇总缺勤描述

对同一员工的所有事项及天数，先拼接，再分组汇总（拼接）：

1. rlt1 = df %>%
   
2.     mutate(info = str_c(事项, 天数, "天")) %>%
   
3.     group_by(姓名) %>%
   
4.     summarise(考勤 = str_c(info, collapse = "，"))
   
5. rlt1

复制代码

写出到 Excel 文件：

1. write_xlsx(rlt1, "员工缺勤描述汇总表.xlsx")    # 部分结果截图

复制代码

4 汇总2：按员工汇总缺勤扣发金额

要计算缺勤扣发金额，首先需要准备一个查找表，提供每种缺勤，及对应的扣发计算公式（根据天数）。

一个计算公式实际上是一个函数，所以查找表有两列：事项（缺勤）、计算公式（函数）

我这里只是演示，是自己编的计算公式，基本格式是某缺勤在一定天数之内不扣钱，超过部分按100元/天。既然有基本格式，就有必要为其写个辅助函数，省的重复写代码。

1. f = function(x, th) ifelse(x > th, (x - th) * 100, 0)

复制代码

创建查找表：

1. lookup = tibble(
   
2.   事项 = count(df, 事项)$事项,
   
3.   fun = list(\(x) f(x, 14), \(x) f(x, 180), \(x) f(x, 7), \(x) x * 0, \(x) f(x, 14),
   
4.               \(x) x * 0, \(x) f(x, 30), \(x) f(x, 7), \(x) f(x, 7), \(x) f(x, 7)))
   
5. lookup

复制代码

注意，函数需要用列表列存放。另外，这里的函数必须得是 R 函数，不能是purrr 公式，因为后续要用于 invoke_map_*() 是不支持的。

接着，从前文清洗好的 df 数据开始，根据事项匹配左连接查找表 lookup：

1. rlt2 = df %>%
   
2.   left_join(lookup, by = "事项")
   
3. rlt2

复制代码

接下来，就是将 fun 列的函数，分别应用到天数列，计算出扣发金额。这也是我第一次遇到需要使用 invoke_map_*() 的实际场景。

1. rlt2 = rlt2 %>%
   
2.     mutate(money = invoke_map_dbl(fun, 天数))
   
3. rlt2

复制代码

每人的扣发金额都计算出来了，最后，就是简单的分组汇总了：

1. rlt2 = rlt2 %>%
   
2.     group_by(姓名) %>%
   
3.     summarise(扣发金额 = sum(money))
   
4. rlt2

复制代码

写出到 Excel 略。

问题圆满解决！

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏1 回帖

关键词：EXCEL 办公自动化 xcel vers exce R语言 tidyverse Excel 数据思维 张敬信

接1楼，若去掉不必要的中间结果展示，借助管道，加上写出到 Excel，完整代码如下：

1. library(tidyverse)
   
2. library(readxl)
   
3. library(writexl)
   
4. # 自定义函数根据年月计算当月天数
   
5. mdays = function(month, year = 2022) {
   
6.   x = str_c(year, "-", month, "-01")
   
7.   lubridate::days_in_month(x)
   
8. }  
   
9. # 数据清洗
   
10. df = read_xlsx("data.xlsx") %>%
    
11.   pivot_longer(-姓名, names_to = "月份", values_to = "事项",
    
12.                values_drop_na = TRUE, names_transform = parse_number) %>%
    
13.   separate_rows(事项, sep = "，|、|；") %>%
    
14.   extract(事项, into = c("事项", "天数"), regex = "(\\D+)(\\d.*|$)") %>%
    
15.   mutate(天数 = parse_number(天数),
    
16.          天数 = ifelse(is.na(天数), mdays(月份), 天数),
    
17.          事项 = case_when(
    
18.            str_detect(事项, "年休|休假") ~  "年休假",
    
19.            str_detect(事项, "居家") ~  "居家",
    
20.            str_detect(事项, "病假") ~  "病假",
    
21.            str_detect(事项, "产假") ~  "产假",
    
22.            TRUE ~ 事项)) %>%
    
23.   group_by(姓名, 事项) %>%
    
24.   summarise(天数 = sum(天数), .groups = "drop")
    
25. 
    
26. # 汇总1: 按员工汇总缺勤描述
    
27. df %>%
    
28.   mutate(info = str_c(事项, 天数, "天")) %>%
    
29.   group_by(姓名) %>%
    
30.   summarise(考勤 = str_c(info, collapse = "，")) %>%
    
31.   write_xlsx(rlt1, "员工缺勤描述汇总表.xlsx")
    
32. 
    
33. # 汇总2: 按员工汇总缺勤扣发金额
    
34. f = function(x, th) ifelse(x > th, (x - th) * 100, 0)
    
35. lookup = tibble(
    
36.   事项 = count(df, 事项)$事项,
    
37.   fun = list(\(x) f(x, 14), \(x) f(x, 180), \(x) f(x, 7), \(x) x * 0, \(x) f(x, 14),
    
38.              \(x) x * 0, \(x) f(x, 30), \(x) f(x, 7), \(x) f(x, 7), \(x) f(x, 7)))
    
39. df %>%
    
40.   left_join(lookup, by = "事项") %>%
    
41.   mutate(money = invoke_map_dbl(fun, 天数)) %>%
    
42.   group_by(姓名) %>%
    
43.   summarise(扣发金额 = sum(money)) %>%
    
44.   write_xlsx("按员工汇总缺勤扣发金额.xlsx")

复制代码