10 多個EXCEL檔的資料匯整與分析

以R整理多個excel檔的資料並加以統計 - 以學生學習成效資料為例。

10.1 學習成效分析

下載學習成效原始資料,並統計2017~2020年所有課程的學習成效。

先將所有檔案放到工作目錄下的一個資料夾(例如TableDemo資料夾)內,並在R中設定好工作目錄。(你也可以將此資料夾設為工作目錄,這邊因為Rmarkdown的關係,所以這樣設定。)

setwd("D:\\Dropbox\\Working\\教師社群")

10.2 讀入單一工作表並抽取所需資料

先讀入單一工作表,並抽取學習成效的資料。

以readxl套件,讀取UG-2017.xlsx的sheet 1。因為表格中沒有column name,readxl會出現警告訊息,不想看到的話可以加上suppressMessages()。

library(readxl)
suppressMessages(qData <- read_xlsx("TableDemo\\UG-2017.xlsx", 1))

以which()找出「三、學習成效評估」的位置,為「學習成效評估表」的起始位置;並以整個表格長度做為「學習成效評估表」的終點位置。

index_start <- which(qData$`一、教學意見量化結果`=="三、學習成效評估")
index_end <- length(qData$`一、教學意見量化結果`)

抓出「學習成效評估表」的所有數值。

library(dplyr)
myData <- slice(qData,index_start:index_end)  
# myData <- qData[index_start:index_end,]  #相當於這樣寫 
myData
一、教學意見量化結果 …2 …3 …4 …5 …6 …7 …8
三、學習成效評估 NA NA NA NA NA NA NA
NA NA NA NA NA NA NA NA
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
1.能獲得本科目(領域)之知識 21 12 9 0 0 0 4.57
NA NA 57.00% 43.00% 0% 0% 0% NA
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
2.能獲得本科目(領域)之重要概念 21 12 7 2 0 0 4.48
NA NA 57.00% 33.00% 10.00% 0% 0% NA
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
5.能學到專業領域的重要技術 21 12 5 4 0 0 4.38
NA NA 57.00% 24.00% 19.00% 0% 0% NA
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
7.能提升實務操作的能力 21 12 5 4 0 0 4.38
NA NA 57.00% 24.00% 19.00% 0% 0% NA
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
15.能提升資料蒐集分析與運用能力 21 12 8 1 0 0 4.52
NA NA 57.00% 38.00% 5.00% 0% 0% NA
本課程學習成效平均分數 NA NA NA NA NA NA 4.47

刪除NA的列。

data1 <- na.omit(myData) # way1
## data1 <- myData[complete.cases(myData), ] #way2
## data1 <- myData[complete.cases(myData[ , 1:8]),] #way3: 可刪除部份data

data1
一、教學意見量化結果 …2 …3 …4 …5 …6 …7 …8
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
1.能獲得本科目(領域)之知識 21 12 9 0 0 0 4.57
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
2.能獲得本科目(領域)之重要概念 21 12 7 2 0 0 4.48
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
5.能學到專業領域的重要技術 21 12 5 4 0 0 4.38
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
7.能提升實務操作的能力 21 12 5 4 0 0 4.38
題目 答題人數 (5分)非常符合 (4分)符合 (3分)尚可 (2分)不符合 (1分)非常不符合 單題指標
15.能提升資料蒐集分析與運用能力 21 12 8 1 0 0 4.52

刪掉每個題目表格的title列。

data2 <- subset(data1, `一、教學意見量化結果`!="題目", select=c(1,2,8))
data2
一、教學意見量化結果 …2 …8
1.能獲得本科目(領域)之知識 21 4.57
2.能獲得本科目(領域)之重要概念 21 4.48
5.能學到專業領域的重要技術 21 4.38
7.能提升實務操作的能力 21 4.38
15.能提升資料蒐集分析與運用能力 21 4.52

10.2.1 簡化程式

以%>%來簡化程式,讓程式更具可讀性,也不需在中間過程多存出變項。意即,只要將qData放入後,即可產生tb1 (即上述data2)。

tb1 <- slice(qData,index_start:index_end) %>%
  na.omit() %>%
  subset(`一、教學意見量化結果`!="題目", select=c(1,2,8))

10.2.2 寫成函數

將上述步驟寫成函數anal_Teach_Q,只要給予filename和nSheet即可傳回tb1。

library(readxl)
library(dplyr)

anal_Teach_Q <- function(filename, nSheet){
  suppressMessages(qData <- read_xlsx(filename, nSheet))
  index_start <- which(qData$`一、教學意見量化結果`=="三、學習成效評估")
  index_end <- length(qData$`一、教學意見量化結果`)
  tb1 <- slice(qData,index_start:index_end) %>%
    na.omit() %>%
    subset(`一、教學意見量化結果`!="題目", select=c(1,2,8))
  return(tb1)
}

呼叫anal_Teach_Q,分析「UG-2017.xlsx」的sheet1。

thisfilename <- "TableDemo\\UG-2017.xlsx"
nSheet <- 1
tb1 <- anal_Teach_Q(thisfilename, nSheet)
tb1
一、教學意見量化結果 …2 …8
1.能獲得本科目(領域)之知識 21 4.57
2.能獲得本科目(領域)之重要概念 21 4.48
5.能學到專業領域的重要技術 21 4.38
7.能提升實務操作的能力 21 4.38
15.能提升資料蒐集分析與運用能力 21 4.52

10.3 讀取一個檔案的多個工作表

當有很多個工作表需讀入時,你可以這樣寫:

thisfilename <- "TableDemo\\UG-2017.xlsx"
tb1 <- anal_Teach_Q(thisfilename, 1)
tb2 <- anal_Teach_Q(thisfilename, 2)
tb3 <- anal_Teach_Q(thisfilename, 3)

更有效率的做法是用for迴圈。

tblist <- list()
for (i in 1:3) {
  tb0 <- anal_Teach_Q(thisfilename, i)  
  tblist[[i]] <- tb0
}
# tblist

若要將所有表單放在一起,可以這樣寫。

tbs <- data.frame()
for (i in 1:3) {
  tb0 <- anal_Teach_Q(thisfilename, i)  
  tbs <- rbind(tbs, tb0)
}
tbs
一、教學意見量化結果 …2 …8
1.能獲得本科目(領域)之知識 21 4.57
2.能獲得本科目(領域)之重要概念 21 4.48
5.能學到專業領域的重要技術 21 4.38
7.能提升實務操作的能力 21 4.38
15.能提升資料蒐集分析與運用能力 21 4.52
1.能獲得本科目(領域)之知識 41 4.56
2.能獲得本科目(領域)之重要概念 42 4.64
3.能獲得本科目(領域)之重要原理原則 42 4.5
5.能學到專業領域的重要技術 42 4.57
7.能提升實務操作的能力 42 4.62
8.能提升專業知識的應用能力 42 4.62
15.能提升資料蒐集分析與運用能力 42 4.57
16.能提升探究的能力 42 4.62
1.能獲得本科目(領域)之知識 16 4.56
2.能獲得本科目(領域)之重要概念 16 4.69
3.能獲得本科目(領域)之重要原理原則 16 4.63
4.能增進對該領域持續學習的興趣 14 4.71
7.能提升實務操作的能力 15 4.67
8.能提升專業知識的應用能力 16 4.75
12.能促進個人品德實踐或社會關懷情操 16 4.56
14.能提升問題解決能力 16 4.38
18.能激發主動思考及判斷 16 4.56
19.能激發創新創意思考 16 4.69
26.能增進口語或書面表達能力 16 4.63
27.能增進人際溝通與合作能力 16 4.63
31.能提升對未來就業的信心 16 4.56

統計同項目的平均值和個數。由於tbs的項目不是數字,故須先轉為數字。

tbs[,c(2:3)] <- lapply(tbs[,c(2:3)], as.numeric)
tbs1 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), mean)
tbs2 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), length)
tbs1
Group.1 x
1.能獲得本科目(領域)之知識 4.563333
12.能促進個人品德實踐或社會關懷情操 4.560000
14.能提升問題解決能力 4.380000
15.能提升資料蒐集分析與運用能力 4.545000
16.能提升探究的能力 4.620000
18.能激發主動思考及判斷 4.560000
19.能激發創新創意思考 4.690000
2.能獲得本科目(領域)之重要概念 4.603333
26.能增進口語或書面表達能力 4.630000
27.能增進人際溝通與合作能力 4.630000
3.能獲得本科目(領域)之重要原理原則 4.565000
31.能提升對未來就業的信心 4.560000
4.能增進對該領域持續學習的興趣 4.710000
5.能學到專業領域的重要技術 4.475000
7.能提升實務操作的能力 4.556667
8.能提升專業知識的應用能力 4.685000

將表格整理成dataframe。

tb <- data.frame("item" = tbs1$Group.1, "n" = tbs2$x, "mean" = tbs1$x)
tb
item n mean
1.能獲得本科目(領域)之知識 3 4.563333
12.能促進個人品德實踐或社會關懷情操 1 4.560000
14.能提升問題解決能力 1 4.380000
15.能提升資料蒐集分析與運用能力 2 4.545000
16.能提升探究的能力 1 4.620000
18.能激發主動思考及判斷 1 4.560000
19.能激發創新創意思考 1 4.690000
2.能獲得本科目(領域)之重要概念 3 4.603333
26.能增進口語或書面表達能力 1 4.630000
27.能增進人際溝通與合作能力 1 4.630000
3.能獲得本科目(領域)之重要原理原則 2 4.565000
31.能提升對未來就業的信心 1 4.560000
4.能增進對該領域持續學習的興趣 1 4.710000
5.能學到專業領域的重要技術 2 4.475000
7.能提升實務操作的能力 3 4.556667
8.能提升專業知識的應用能力 2 4.685000

10.4 以for迴圈讀入檔案中的所有工作表

以readxl套件中的excel_sheets來列出所有的工作表名稱,並用length()來自動計數有幾個工作表。

thisfilename <- "TableDemo\\UG-2017.xlsx"
sheetname <- excel_sheets(path = thisfilename)

tbs <- data.frame()
for (j in 1:length(sheetname)) {
  tb0 <- anal_Teach_Q(thisfilename, j)
  tbs <- rbind(tbs, tb0)
}

tbs[,c(2:3)] <- lapply(tbs[,c(2:3)], as.numeric)
tbs1 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), mean)
tbs2 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), length) 
tbave <- data.frame("item" = tbs1$Group.1, "n" = tbs2$x, "mean" = tbs1$x)
tbave
item n mean
1.能獲得本科目(領域)之知識 12 4.578333
10.能提升人文素養 2 4.370000
11.能提升文學欣賞或審美能力 2 4.215000
12.能促進個人品德實踐或社會關懷情操 4 4.455000
13.能了解專業倫理 7 4.480000
14.能提升問題解決能力 8 4.433750
15.能提升資料蒐集分析與運用能力 7 4.464286
16.能提升探究的能力 4 4.567500
17.能提升邏輯推理的能力 3 4.486667
18.能激發主動思考及判斷 4 4.567500
19.能激發創新創意思考 4 4.437500
2.能獲得本科目(領域)之重要概念 15 4.628667
20.能提升創作能力 1 4.130000
21.能對觀點或現象進行鑑賞與評論 1 4.240000
22.能增進個人外語語文能力 2 4.155000
23.能強化學習外語的動力 1 3.780000
24.能開拓個人或國際觀視野 1 3.870000
25.能提升多元文化的理解 1 3.820000
26.能增進口語或書面表達能力 4 4.435000
27.能增進人際溝通與合作能力 5 4.506000
28.能增進規劃組織或經營能力 4 4.397500
29.能提升跨領域整合能力 2 4.360000
3.能獲得本科目(領域)之重要原理原則 11 4.631818
30.能提升自我管理能力 2 4.475000
31.能提升對未來就業的信心 2 4.270000
4.能增進對該領域持續學習的興趣 8 4.552500
5.能學到專業領域的重要技術 7 4.525714
6.能增進本科目(領域)的實驗知能 4 4.415000
7.能提升實務操作的能力 8 4.553750
8.能提升專業知識的應用能力 10 4.557000
9.能提升數位科技的應用能力 2 4.120000

將上述寫成function。給定一檔案名稱,即可輸出平均表格。

ave_Teach_Q <- function(filename) {
  sheetname <- excel_sheets(path = filename)
  tbs = data.frame()
  for (nSheet in 1:length(sheetname)) {
    tb0 <- anal_Teach_Q(filename, nSheet)
    tbs <- rbind(tbs, tb0)
  }
  tbs[,c(2:3)] <- lapply(tbs[,c(2:3)], as.numeric)
  tbs1 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), mean) #FUN=mean
  tbs2 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), length) #FUN=length
  tbave <- data.frame("item" = tbs1$Group.1, "n" = tbs2$x, "mean" = tbs1$x)
  return(tbave)
}

呼叫ave_Teach_Q函數。

thisfilename <- "TableDemo\\UG-2017.xlsx"
tbave <- ave_Teach_Q(thisfilename)
tbave
item n mean
1.能獲得本科目(領域)之知識 12 4.578333
10.能提升人文素養 2 4.370000
11.能提升文學欣賞或審美能力 2 4.215000
12.能促進個人品德實踐或社會關懷情操 4 4.455000
13.能了解專業倫理 7 4.480000
14.能提升問題解決能力 8 4.433750
15.能提升資料蒐集分析與運用能力 7 4.464286
16.能提升探究的能力 4 4.567500
17.能提升邏輯推理的能力 3 4.486667
18.能激發主動思考及判斷 4 4.567500
19.能激發創新創意思考 4 4.437500
2.能獲得本科目(領域)之重要概念 15 4.628667
20.能提升創作能力 1 4.130000
21.能對觀點或現象進行鑑賞與評論 1 4.240000
22.能增進個人外語語文能力 2 4.155000
23.能強化學習外語的動力 1 3.780000
24.能開拓個人或國際觀視野 1 3.870000
25.能提升多元文化的理解 1 3.820000
26.能增進口語或書面表達能力 4 4.435000
27.能增進人際溝通與合作能力 5 4.506000
28.能增進規劃組織或經營能力 4 4.397500
29.能提升跨領域整合能力 2 4.360000
3.能獲得本科目(領域)之重要原理原則 11 4.631818
30.能提升自我管理能力 2 4.475000
31.能提升對未來就業的信心 2 4.270000
4.能增進對該領域持續學習的興趣 8 4.552500
5.能學到專業領域的重要技術 7 4.525714
6.能增進本科目(領域)的實驗知能 4 4.415000
7.能提升實務操作的能力 8 4.553750
8.能提升專業知識的應用能力 10 4.557000
9.能提升數位科技的應用能力 2 4.120000

10.5 讀入多個檔案

同理,可以用for迴圈一次讀入多個檔案。

此時需要知道每個檔案的名稱,可以用list.files()來列出所有檔案名稱。

path <- "D:\\Dropbox\\Working\\教師社群\\TableDemo"
files <- list.files(path = path, pattern = "*.xlsx")
# files

讀入所有檔案並列表。

tblist = list()
for (i in 1:length(files)) {
  thisfilename <- paste("TableDemo\\", files[i], sep='')
  tb <- ave_Teach_Q(thisfilename)
  tblist[[i]] <- tb
}

# tblist

僅抓取平均數,並將每個表的mean改為該學期。以利後續處理。

path <- "D:\\Dropbox\\Working\\教師社群\\TableDemo"
files <- list.files(path = path, pattern = "*.xlsx")

tblist = list()
for (i in 1:length(files)) {
  thisfilename <- paste("TableDemo\\", files[i], sep='')
  tb <- ave_Teach_Q(thisfilename)
  tb2 <- as.data.frame(tb[,c(1,3)])
  names(tb2) <- c('item', substr(thisfilename,4,7))
  tblist[[i]] <- tb2
}

# tblist

將所有抓取的表合成一個大表。

tbAll <- Reduce(function(x, y) merge(x, y, all=TRUE, by="item"), tblist)
## Warning in merge.data.frame(x, y, all = TRUE, by = "item"): column names
## 'leDe.x', 'leDe.y' are duplicated in the result
tbAll[,2:ncol(tbAll)] <- round(tbAll[,2:ncol(tbAll)], digits = 2)
tbAll
item leDe.x leDe.y leDe.x leDe.y
1.能獲得本科目(領域)之知識 4.58 4.72 4.63 4.73
10.能提升人文素養 4.37 NA 3.80 4.58
11.能提升文學欣賞或審美能力 4.22 NA 3.71 4.17
12.能促進個人品德實踐或社會關懷情操 4.46 NA 4.30 4.50
13.能了解專業倫理 4.48 4.60 4.04 4.30
14.能提升問題解決能力 4.43 4.54 4.50 4.70
15.能提升資料蒐集分析與運用能力 4.46 4.61 4.52 4.73
16.能提升探究的能力 4.57 4.54 4.53 4.61
17.能提升邏輯推理的能力 4.49 4.60 4.38 4.66
18.能激發主動思考及判斷 4.57 4.68 4.66 4.74
19.能激發創新創意思考 4.44 4.66 4.48 4.61
2.能獲得本科目(領域)之重要概念 4.63 4.73 4.62 4.74
20.能提升創作能力 4.13 4.61 3.82 4.54
21.能對觀點或現象進行鑑賞與評論 4.24 4.60 4.52 4.70
22.能增進個人外語語文能力 4.15 NA 4.26 4.52
23.能強化學習外語的動力 3.78 NA 3.53 4.38
24.能開拓個人或國際觀視野 3.87 NA 3.60 4.39
25.能提升多元文化的理解 3.82 4.58 4.24 4.69
26.能增進口語或書面表達能力 4.44 4.58 4.57 4.64
27.能增進人際溝通與合作能力 4.51 4.61 4.29 4.54
28.能增進規劃組織或經營能力 4.40 NA 4.34 4.50
29.能提升跨領域整合能力 4.36 NA 4.31 4.30
3.能獲得本科目(領域)之重要原理原則 4.63 4.66 4.54 4.75
30.能提升自我管理能力 4.47 4.56 4.42 4.66
31.能提升對未來就業的信心 4.27 NA 3.64 4.61
4.能增進對該領域持續學習的興趣 4.55 4.58 4.50 4.72
5.能學到專業領域的重要技術 4.53 4.80 4.56 4.72
6.能增進本科目(領域)的實驗知能 4.42 4.65 4.45 4.65
7.能提升實務操作的能力 4.55 4.68 4.43 4.71
8.能提升專業知識的應用能力 4.56 4.68 4.57 4.72
9.能提升數位科技的應用能力 4.12 NA 3.62 4.35

也可以用tidyverse package中的purr和dplyr package的full_join()搭配Reduce()來做。

library("tidyverse")
tbAll2 <- reduce(tblist, full_join, by = "item")
# tbAll2

更進階的寫法:以lapply取代for迴圈。

setwd("D:\\Dropbox\\Working\\教師社群\\TableDemo")
all.data <- 
  lapply(files[1:length(files)], function(x)
    ave_Teach_Q(x) %>%
    subset(select = c(1,3)) %>%
    rename(, !!substr(x,4,7) := mean))

tbAll2 <- Reduce(function(x, y) merge(x, y, all=TRUE, by="item"), all.data) %>%
  mutate_if(is.numeric, round, digits = 2)
                 
# tbAll2

將tbAll存成excel檔。

library(writexl)
write_xlsx(tbAll, "學習成效總表.xlsx")

10.6 集大成的程式碼

setwd("D:\\pCloud\\Working\\教師社群\\TableDemo")

library(writexl)
library(readxl)
library(dplyr)

path <- "D:\\pCloud\\Working\\教師社群\\TableDemo"
files <- list.files(path = path, pattern = "*.xlsx")

anal_Teach_Q <- function(filename, nSheet){
  suppressMessages(qData <- read_xlsx(filename, nSheet))
  index_start <- which(qData$`一、教學意見量化結果`=="三、學習成效評估")
  index_end <- length(qData$`一、教學意見量化結果`)
  tb1 <- slice(qData,index_start:index_end) %>%
    na.omit() %>%
    subset(`一、教學意見量化結果`!="題目", select=c(1,2,8))
  return(tb1)
}

ave_Teach_Q <- function(filename) {
  sheetname <- excel_sheets(path = filename)
  tbs <- data.frame()
  for (nSheet in 1:length(sheetname)) {
    tb0 <- anal_Teach_Q(filename, nSheet)
    tbs <- rbind(tbs, tb0)
  }
  tbs[,c(2:3)] <- lapply(tbs[,c(2:3)], as.numeric)
  tbs1 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), mean) #FUN=mean
  tbs2 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), length) #FUN=length
  tbave <- data.frame("item" = tbs1$Group.1, "n" = tbs2$x, "mean" = tbs1$x)
  return(tbave)
}

tblist <- list()
for (i in 1:length(files)) {
  thisfilename <- files[i]
  tb <- ave_Teach_Q(thisfilename)
  tb2 <- tb[,c(1,3)]
  names(tb2)[2] <- substr(thisfilename,4,7)
  tblist[[i]] <- tb2
}

tbAll <- Reduce(function(x, y) merge(x, y, all=TRUE, by="item"), tblist)

如果不用任何%>%或funcion,程式會長這樣。

library(readxl)
library(writexl)
library(dplyr)

setwd("D:\\pCloud\\Working\\教師社群\\TableDemo")
path <- "D:\\pCloud\\Working\\教師社群\\TableDemo"

files <- list.files(path = path, pattern = "*.xlsx")
datalist <- list()
for (i in 1:length(files)) {
  thisfilename <- files[i]
  sheetname <- excel_sheets(path = thisfilename)
  tbs <- data.frame()
  for (j in 1:length(sheetname)) {
    suppressMessages(qData <- read_xlsx(thisfilename, j))
    index_start <- which(qData$`一、教學意見量化結果`=="三、學習成效評估")
    index_end <- length(qData$`一、教學意見量化結果`)
    myData <- slice(qData,index_start:index_end)
    myData1 <- na.omit(myData) 
    myData2 <- myData1[which(myData1$`一、教學意見量化結果`!="題目"),]
    myData2 <- myData2[,c(1,2,8)]
    tbs <- rbind(tbs, myData2)
  }
  tbs[,c(2:3)] <- lapply(tbs[,c(2:3)], as.numeric)
  tbs1 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), mean)
  tbs2 <- aggregate(tbs$...8, by=list(tbs$`一、教學意見量化結果`), length)
  tb <- data.frame("item" = tbs1$Group.1, "n" = tbs2$x, "mean" = tbs1$x)
  tb2 <- tb[,c(1,3)]
  names(tb2)[2] <- substr(thisfilename,4,7)
  datalist[[i]] <- tb2
}

tbAll <- Reduce(function(x, y) merge(x, y, all=TRUE, by="item"), datalist)