1 问题描述

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

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

实际数据往往存在:

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

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

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

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

下面来逐步解决问题。

先加载包:

library(tidyverse) library(readxl) libary(writexl)

2 数据清洗

2.1 数据读取与重塑

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

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

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

df = data %>% separate_rows(事项, sep = ",|、|;") df

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

2.2 文本数据处理

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

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

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

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

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

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

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

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

df %>% count(事项)

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

df = df %>% mutate( 事项 = case_when(str_detect(事项, "年休|休假") ~ "年休假", str_detect(事项, "居家") ~ "居家", str_detect(事项, "病假") ~ "病假", str_detect(事项, "产假") ~ "产假", TRUE ~ 事项)) df

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

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

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

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

对同一员工的所有事项及天数,先拼接,再分组汇总(拼接):

rlt1 = df %>% mutate(info = str_c(事项, 天数, "天")) %>% group_by(姓名) %>% summarise(考勤 = str_c(info, collapse = ",")) rlt1

写出到 Excel 文件:

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

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

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

一个计算公式实际上是一个函数,所以查找表有两列:事项(缺勤)、计算公式(函数)

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

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

创建查找表:

lookup = tibble( 事项 = count(df, 事项)$事项, fun = list((x) f(x, 14), (x) f(x, 180), (x) f(x, 7), (x) x * 0, (x) f(x, 14), (x) x * 0, (x) f(x, 30), (x) f(x, 7), (x) f(x, 7), (x) f(x, 7))) lookup

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

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

rlt2 = df %>% left_join(lookup, by = "事项") rlt2

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

rlt2 = rlt2 %>% mutate(money = invoke_map_dbl(fun, 天数)) rlt2

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

rlt2 = rlt2 %>% group_by(姓名) %>% summarise(扣发金额 = sum(money)) rlt2

写出到 Excel 略。

问题圆满解决!

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

library(tidyverse) library(readxl) library(writexl) # 自定义函数根据年月计算当月天数 mdays = function(month, year = 2022) { x = str_c(year, "-", month, "-01") lubridate::days_in_month(x) } # 数据清洗 df = read_xlsx("data.xlsx") %>% pivot_longer(-姓名, names_to = "月份", values_to = "事项", values_drop_na = TRUE, names_transform = parse_number) %>% separate_rows(事项, sep = ",|、|;") %>% extract(事项, into = c("事项", "天数"), regex = "(\D+)(\d.*|$)") %>% mutate(天数 = parse_number(天数), 天数 = ifelse(is.na(天数), mdays(月份), 天数), 事项 = case_when( str_detect(事项, "年休|休假") ~ "年休假", str_detect(事项, "居家") ~ "居家", str_detect(事项, "病假") ~ "病假", str_detect(事项, "产假") ~ "产假", TRUE ~ 事项)) %>% group_by(姓名, 事项) %>% summarise(天数 = sum(天数), .groups = "drop") # 汇总1: 按员工汇总缺勤描述 df %>% mutate(info = str_c(事项, 天数, "天")) %>% group_by(姓名) %>% summarise(考勤 = str_c(info, collapse = ",")) %>% write_xlsx(rlt1, "员工缺勤描述汇总表.xlsx") # 汇总2: 按员工汇总缺勤扣发金额 f = function(x, th) ifelse(x > th, (x - th) * 100, 0) lookup = tibble( 事项 = count(df, 事项)$事项, fun = list((x) f(x, 14), (x) f(x, 180), (x) f(x, 7), (x) x * 0, (x) f(x, 14), (x) x * 0, (x) f(x, 30), (x) f(x, 7), (x) f(x, 7), (x) f(x, 7))) df %>% left_join(lookup, by = "事项") %>% mutate(money = invoke_map_dbl(fun, 天数)) %>% group_by(姓名) %>% summarise(扣发金额 = sum(money)) %>% write_xlsx("按员工汇总缺勤扣发金额.xlsx")