fNIRS Data Preprocessing使用步骤

 1for i = 1:9 # i代表 sub0 后的数量 这里表示 sub01到 sub09
 2for j = 1:2 # j 代表run数量，有几个修改一下即可
 3for k = 1:4 # k 代表 Probe数量，即光极片数量
 4a = ['sub0',num2str(i),'_run', num2str(j),'_HBA_Probe', num2str(k),'_Oxy.csv']
 5xlsread(a,1)
 6b = ['sub0',num2str(i),'_run', num2str(j),'_HBA_Probe', num2str(k),'_Oxy.mat']
 7save(b)
 8end
 9end
10end

  1Option Explicit
  2
  3Sub 组内整合条件()
  4    Dim ws As Worksheet
  5    Dim wb As Workbook
  6    Dim newWb As Workbook
  7    Dim myPath As String
  8    Dim myFile As String
  9    Dim i As Long
 10    Dim col As Long
 11    Dim lastRow As Long
 12    Dim header As Range
 13    Dim filtereRange As Range
 14    Dim filterValue As String
 15
 16    Application.ScreenUpdating = False
 17    
 18    ' 获取当前文件夹路径'
 19    myPath = InputBox("请输入文件路径:") & "\"
 20    myFile = Dir(myPath & "*.xlsx")
 21    
 22    ' 新建all_condition工作簿'
 23    Set newWb = Workbooks.Add
 24    newWb.SaveAs myPath & "all_condition.xlsx"
 25    Set ws = newWb.Worksheets(1)
 26    
 27    col = 3
 28    ' 遍历目录下的所有Excel文件'
 29    Do While myFile <> ""
 30        If myFile <> "all_condition.xlsx" Then
 31            ' 打开原始工作簿'
 32            Set wb = Workbooks.Open(myPath & myFile)
 33            
 34            ' 复制第2个工作表的第3到6列到新工作簿'
 35            With wb.Worksheets("Sheet1DataListSPSS")
 36                lastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
 37                .Range(.Cells(1, 3), .Cells(lastRow, 6)).Copy ws.Cells(1, col)
 38            End With
 39            
 40            ' 补充表头'
 41            For i = 1 To 4
 42                ws.Cells(1, col + i - 1).Value = ws.Cells(1, col + i - 1).Value & "_" & Replace(myFile, ".xlsx", "")
 43            Next i
 44            
 45            col = col + 4
 46            wb.Close SaveChanges:=False
 47        End If
 48        myFile = Dir
 49    Loop
 50    
 51    '复制第一个原始工作簿的前两列'
 52    Set wb = Workbooks.Open(myPath & Dir(myPath & "Condition1.xlsx"))
 53    With wb.Worksheets("Sheet1DataListSPSS")
 54        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
 55        .Range(.Cells(1, 1), .Cells(lastRow, 2)).Copy ws.Cells(1, 1)
 56    End With
 57    wb.Close SaveChanges:=False
 58    
 59    ' 保存新工作簿修改'
 60    newWb.Save
 61    
 62    ' 复制第一个工作表'
 63    ws.Copy After:=ws
 64    Set ws = newWb.Worksheets(2)
 65    
 66    ' 添加subject列'
 67    ws.Columns(2).Insert
 68    ws.Cells(1, 1).Value = "subject_pair"
 69    ws.Cells(1, 2).Value = "subject"
 70    
 71    ' 修改subject列内容'
 72    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
 73    For i = 2 To lastRow
 74        Dim parts() As String
 75        parts = Split(ws.Cells(i, 1).Value, "_")
 76        If InStr(parts(2), "Probe1") > 0 Or InStr(parts(2), "Probe2") > 0 Then
 77            ws.Cells(i, 2).Value = parts(0) & "_" & parts(1)
 78        Else
 79            ws.Cells(i, 2).Value = "sub" & Format(CInt(Mid(parts(0), 4)) + 1, "000") & "_" & parts(1)
 80            ' 交换第3到6列和第7到10列'
 81            Dim temp As Variant
 82            Dim j As Long
 83            Dim k As Long
 84            For j = 4 To 7
 85                temp = ws.Cells(i, j).Value
 86                ws.Cells(i, j).Value = ws.Cells(i, j + 4).Value
 87                ws.Cells(i, j + 4).Value = temp
 88            Next j
 89            
 90            ' 交换第11到14列和第15到18列'
 91            For k = 12 To 15
 92                temp = ws.Cells(i, k).Value
 93                ws.Cells(i, k).Value = ws.Cells(i, k + 4).Value
 94                ws.Cells(i, k + 4).Value = temp
 95            Next k
 96        End If
 97    Next i
 98    
 99    ' 删除第1列并排序'
100    ws.Columns(1).Delete
101    ws.Sort.SortFields.Clear
102    ws.Sort.SortFields.Add Key:=ws.Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
103    ws.Sort.SortFields.Add Key:=ws.Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
104    With ws.Sort
105        .SetRange ws.Range("A1").CurrentRegion
106        .Header = xlYes
107        .MatchCase = False
108        .Orientation = xlTopToBottom
109        .SortMethod = xlPinYin
110        .Apply
111    End With
112    ' Turn on screen updating'
113    Application.ScreenUpdating = True
114    newWb.Save
115End Sub

 1Option Explicit
 2'切分通道
 3Sub 组内切分通道()
 4    Dim wbSource As Workbook
 5    Dim wsSource As Worksheet
 6    Dim wsNew As Worksheet
 7    Dim rngData As Range
 8    Dim cell As Range
 9    Dim filterValue As Variant
10    Dim dict As Object
11    Dim key As Variant
12    
13    ' 1. 选择要执行的工作簿，将输入的工作簿第2个工作表设置为活动表
14    Set wbSource = Workbooks.Open(Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm"))
15    Set wsSource = wbSource.Worksheets(2)
16    wsSource.Activate
17    
18    ' 2. 根据第2列值筛选表格数据
19    Set rngData = wsSource.Range("A1").CurrentRegion
20    Set dict = CreateObject("Scripting.Dictionary")
21    
22    ' a. 重复值只筛选一次，空白值不筛选，从第2列第2个单元格开始筛选
23    For Each cell In rngData.Columns(2).Cells
24        If cell.Row > 1 And Not IsEmpty(cell.Value) Then
25            dict(cell.Value) = 1
26        End If
27    Next cell
28    
29    ' b. 根据筛选值创建新表，表名字为筛选值
30    ' c. 将筛选后的值保存到对应名字的新表中
31    ' d. 筛选结束后取消筛选
32    Application.ScreenUpdating = False
33    For Each key In dict.keys
34        wsSource.Rows(1).AutoFilter Field:=2, Criteria1:=key
35        Set wsNew = wbSource.Worksheets.Add(After:=wbSource.Worksheets(wbSource.Worksheets.Count))
36        wsNew.Name = key
37        rngData.SpecialCells(xlCellTypeVisible).Copy Destination:=wsNew.Range("A1")
38        wsSource.Rows(1).AutoFilter
39    Next key
40    
41    ' 3. 删除第1个和第二个工作表
42    Application.DisplayAlerts = False
43    wbSource.Worksheets(1).Delete
44    wsSource.Delete
45    Application.DisplayAlerts = True
46    
47    ' 4. 将剩余工作表中第2列删除
48    For Each wsNew In wbSource.Worksheets
49        wsNew.Columns(2).Delete
50    Next wsNew
51    
52    ' 5. 保存工作簿到当前工作簿下
53    wbSource.SaveAs wbSource.Path & "\" & Left(wbSource.Name, InStrRev(wbSource.Name, ".") - 1) & "_split"
54    Application.ScreenUpdating = True
55    MsgBox "操作完成"
56End Sub
57
58wbSource.SaveAs 

 1Sub AverageRuns()
 2    Dim originalWorkbook As Workbook
 3    Dim newWorkbook As Workbook
 4    Dim originalWorksheet As Worksheet
 5    Dim newWorksheet As Worksheet
 6    Dim runCount As Integer
 7    Dim rowCount As Integer
 8    Dim colCount As Integer
 9    Dim currentRow As Integer
10    Dim currentCol As Integer
11    Dim sum As Double
12    Dim count As Integer
13    Dim average As Double
14    
15    '获取当前活动的工作簿'
16    Set originalWorkbook = ActiveWorkbook
17    
18    '通过对话框获取run次数'
19    runCount = InputBox("请输入run次数:", "输入run次数")
20    
21    '创建一个新的工作簿，用于保存平均后的结果'
22    Set newWorkbook = Workbooks.Add
23    
24    '循环处理每个工作表'
25    For Each originalWorksheet In originalWorkbook.Worksheets
26        '添加一个新的工作表，并将名称设置为原名称+_average'
27        Set newWorksheet = newWorkbook.Worksheets.Add(After:=newWorkbook.Worksheets(newWorkbook.Worksheets.Count))
28        newWorksheet.Name = originalWorksheet.Name & "_average"
29        
30        '获取行数和列数'
31        rowCount = originalWorksheet.Cells(Rows.Count, 1).End(xlUp).Row
32        colCount = originalWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
33        
34        '添加行标题'
35        For currentCol = 2 To colCount
36            newWorksheet.Cells(1, currentCol).Value = originalWorksheet.Cells(1, currentCol)
37        Next currentCol
38        
39        '添加列标题并计算每个被试每个通道的均值'
40        currentRow = 2
41        For i = 2 To rowCount Step runCount
42            newWorksheet.Cells(currentRow, 1).Value = Left(originalWorksheet.Cells(2 + runCount * (currentRow - 2), 1), 6)
43            For currentCol = 2 To colCount
44                sum = 0
45                count = 0
46                For k = i To i + runCount - 1
47                    If Not IsEmpty(originalWorksheet.Cells(k, currentCol)) Then
48                        If originalWorksheet.Cells(k,currentCol) <> 0 Then
49                            sum = sum + CDbl(originalWorksheet.Cells(k, currentCol).Value)
50                            count = count + 1
51                        End If
52                    End If
53                Next k
54                If count > 0 Then
55                    average = sum / count
56                Else
57                    average = 0
58                End If
59                newWorksheet.Cells(currentRow, currentCol).Value = average
60            Next currentCol
61            currentRow = currentRow + 1
62        Next i
63    Next originalWorksheet
64
65    '保存新的工作簿到当前文件夹下'
66    newWorkbook.SaveAs originalWorkbook.Path & "\" & originalWorkbook.Name & "_average.xlsx"
67    newWorkbook.Close SaveChanges:=True
68End Sub

 1Option Explicit
 2
 3Sub 组间提取相关数据()
 4    Dim folderPath As String
 5    Dim fileName As String
 6    Dim wbSource As Workbook, wbNew As Workbook
 7    Dim wsSource As Worksheet, wsTrueCol As Worksheet, wsPesudoCol As Worksheet
 8    Dim cellCorrMatrix As Range, cellPseudoCorrMatrix As Range
 9    Dim startCell As Range
10    Dim i As Long, j As Long
11    Dim newRowTrue As Long, newRowPesudo As Long
12    
13    ' 选择目录
14    With Application.FileDialog(msoFileDialogFolderPicker)
15        If .Show = -1 Then
16            folderPath = .SelectedItems(1)
17        Else
18            Exit Sub
19        End If
20    End With
21    
22    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
23    
24    ' 遍历目录下的所有工作簿
25    fileName = Dir(folderPath & "*.xls*")
26    Application.ScreenUpdating = False
27    Do While fileName <> ""
28        Set wbSource = Workbooks.Open(folderPath & fileName)
29        
30        ' 创建新工作簿并命名工作表
31        Set wbNew = Workbooks.Add
32        Set wsTrueCol = wbNew.Worksheets(1)
33        wsTrueCol.Name = "True_Col"
34        Set wsPesudoCol = wbNew.Worksheets.Add(After:=wsTrueCol)
35        wsPesudoCol.Name = "Pesudo_Col"
36        newRowTrue = 2
37        newRowPesudo = 2
38        
39        
40        
41        ' 遍历原始工作簿的所有工作表
42        For Each wsSource In wbSource.Worksheets
43            Set cellCorrMatrix = wsSource.Cells.Find("Correlation matrix")
44            Set cellPseudoCorrMatrix = wsSource.Cells.Find("Correlation matrix (pseudo)")
45
46            chCounts = Application.WorksheetFunction.CountA(wsSource.Rows(1)) \ 2
47            wsSource.Rows(1).Cells(1).Resize(, chCounts).Copy Destination:=wsTrueCol.Cells(1, 2)
48            wsSource.Rows(1).Cells(1).Resize(, chCounts).Copy Destination:=wsPesudoCol.Cells(1, 2)
49            
50            ' 提取相关值
51            If Not cellCorrMatrix Is Nothing Then
52                Set startCell = cellCorrMatrix.Offset(50, 1)
53                
54                For i = 0 To chCounts - 1
55                'i = 0
56                'Do While Not IsEmpty(startCell.Offset(i, i))
57                    wsTrueCol.Cells(newRowTrue, i + 2).Value = startCell.Offset(i, i).Value
58                    wsTrueCol.Cells(newRowTrue, 1).Value = Left(wsSource.Name, 11)
59                    'i = i + 1
60                'Loop
61                Next i
62                newRowTrue = newRowTrue + 1
63            End If
64            
65            ' 提取伪相关值
66            If Not cellPseudoCorrMatrix Is Nothing Then
67                Set startCell = cellPseudoCorrMatrix.Offset(50, 1)
68                'j = 0
69                'Do While Not IsEmpty(startCell.Offset(j, j))
70                For j = 0 To chCounts - 1
71                    wsPesudoCol.Cells(newRowPesudo, j + 2).Value = startCell.Offset(j, j).Value
72                    wsPesudoCol.Cells(newRowPesudo, 1).Value = Left(wsSource.Name, 11)
73                    'j = j + 1
74                'Loop
75                Next j
76                newRowPesudo = newRowPesudo + 1
77            End If
78        Next wsSource
79        
80        ' 保存新工作簿
81        wbNew.SaveAs folderPath & Left(wbSource.Name, InStrRev(wbSource.Name, ".") - 1) & "_ColExt.xlsx"
82        wbNew.Close SaveChanges:=False
83        wbSource.Close SaveChanges:=False
84        fileName = Dir
85    Loop
86    
87    Application.ScreenUpdating = True
88    MsgBox "提取相关数据完成！"
89End Sub

 1# # 安装需要的包
 2if (!require(readxl)) install.packages("readxl")
 3if (!require(writexl)) install.packages("writexl")
 4if (!require(tidyverse)) install.packages("tidyverse")
 5if (!require(effsize)) install.packages("effsize")
 6#if (!require(lsr)) install.packages("lsr")
 7library(readxl)
 8library(writexl)
 9library(tidyverse)
10library(effsize)
11#library(lsr)
12# 程序名称为"t检验"
13t_test <- function() {
14  # 选取工作目录
15  setwd(choose.dir())
16  
17  # 选取目录下所有excel工作簿循环执行程序
18  files <- list.files(path = getwd(), pattern = "\\.xlsx$", full.names = TRUE)
19  ttest_result_list <- list()
20  
21  for (file in files) {
22    # 读取工作簿内的两个工作表
23    sheet1 <- read_excel(file, sheet = 1)
24    sheet2 <- read_excel(file, sheet = 2)
25    
26    # 初始化结果数据框
27    ttest_res <- data.frame(Column = character(), p = numeric(), t = numeric(), d = numeric(), stringsAsFactors = FALSE)
28    
29    # 从第2列开始进行t检验和Cohen's d计算
30    for (col_idx in 2:ncol(sheet1)) {
31      data1 <- sheet1[-1, col_idx]
32      data2 <- sheet2[-1, col_idx]
33      data1_num <- as.matrix(data1)
34      data2_num <- as.matrix(data2)
35      ttest <- t.test(data1_num, data2_num, paired = TRUE, var.equal = TRUE, conf.level = 0.95)
36
37      cohen_d <- cohen.d(data1_num, data2_num)
38      
39      ttest_res <- rbind(ttest_res, data.frame(Column = colnames(sheet1)[col_idx], p = ttest$p.value, t = ttest$statistic, d = abs(cohen_d$estimate), stringsAsFactors = FALSE))
40    }
41    filename <- sub(".xlsx", "", basename(file))
42    
43    # 将每一个工作簿的结果保存至ttest_result对应的工作表内，名称为执行程序的工作簿的名称
44    ttest_result_list[[filename]] <- ttest_res
45  }
46  
47  # 将每一次t检验的结果输出至一个新的工作簿，名称为"ttest_result"保存在当前目录下
48  write_xlsx(ttest_result_list, "ttest_result.xlsx")
49  infoMes <- "检验完成!"
50  print(infoMes)
51}
52
53# 运行t检验程序
54t_test()

 1Option Explicit
 2
 3Sub 组间切分通道()
 4    Dim fDialog As FileDialog, sFolderPath As String
 5    Dim oFSO As Object, oFolder As Object, oFile As Object
 6    Dim oOriginalWorkbook As Workbook, oNewWorkbook As Workbook
 7    Dim oOriginalWorksheet As Worksheet, oNewWorksheet As Worksheet
 8    Dim lLastCol As Long, lLastRow As Long, i As Long, j As Long, k As Long
 9    Dim sFileName As String, sSheetName As String
10    
11    ' 选择文件夹
12    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
13    fDialog.Title = "选择工作目录"
14    fDialog.AllowMultiSelect = False
15    If fDialog.Show <> -1 Then Exit Sub
16    sFolderPath = fDialog.SelectedItems(1)
17    Application.ScreenUpdating = False
18    '创建结果文件夹
19    MkDir sFolderPath & "\result"
20    ' 创建新工作簿 "all_condition_split"
21    Set oNewWorkbook = Workbooks.Add
22    oNewWorkbook.SaveAs sFolderPath & "\result" & "\" & "all_condition_split.xlsx"
23    
24   ' 遍历工作目录下的所有Excel文件
25    Set oFSO = CreateObject("Scripting.FileSystemObject")
26    Set oFolder = oFSO.GetFolder(sFolderPath)
27    k = 1
28    For Each oFile In oFolder.Files
29        If oFSO.GetExtensionName(oFile.Name) = "xlsx" Or oFSO.GetExtensionName(oFile.Name) = "xls" Then
30            If oFile.Name <> "all_condition_split.xlsx" Then
31                ' 打开原始工作簿
32                Set oOriginalWorkbook = Workbooks.Open(oFile.Path)
33                Set oOriginalWorksheet = oOriginalWorkbook.Worksheets(2)
34                
35                ' 新建工作表
36                If k = 1 Then
37                    lLastCol = oOriginalWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
38                    For i = 2 To lLastCol
39                        sSheetName = oOriginalWorksheet.Cells(1, i).Value
40                        Set oNewWorksheet = oNewWorkbook.Worksheets.Add(, oNewWorkbook.Worksheets(oNewWorkbook.Worksheets.Count))
41                        oNewWorksheet.Name = sSheetName
42                        oNewWorksheet.Cells(1, 1).Value = oOriginalWorksheet.Cells(1, 1).Value
43                    Next i
44                End If
45                
46                ' 复制数据到新工作簿
47                For i = 2 To lLastCol
48                    Set oNewWorksheet = oNewWorkbook.Worksheets(i)
49                    lLastRow = oOriginalWorksheet.Cells(Rows.Count, i).End(xlUp).Row
50                    oOriginalWorksheet.Range(oOriginalWorksheet.Cells(2, i), oOriginalWorksheet.Cells(lLastRow, i)).Copy oNewWorksheet.Cells(2, k + 1)
51                    oNewWorksheet.Cells(1, k + 1).Value = Split(oFile.Name, "_")(0)
52                    
53                    ' 复制第一列数据到新工作簿
54                    oOriginalWorksheet.Range(oOriginalWorksheet.Cells(2, 1), oOriginalWorksheet.Cells(lLastRow, 1)).Copy oNewWorksheet.Cells(2, 1)
55                Next i
56                
57                k = k + 1
58                oOriginalWorkbook.Close False
59            End If
60        End If
61    Next oFile
62    
63    ' 保存新工作簿
64    oNewWorkbook.Save
65    oNewWorkbook.Close
66    
67    ' 打开 "all_condition_split" 工作簿
68    Set oNewWorkbook = Workbooks.Open(sFolderPath & "\result" & "\" & "all_condition_split.xlsx")
69    
70    ' 循环操作每个工作表
71    For Each oNewWorksheet In oNewWorkbook.Worksheets
72        lLastRow = oNewWorksheet.Cells(Rows.Count, 1).End(xlUp).Row
73        oNewWorksheet.Range(oNewWorksheet.Cells(2, 3), oNewWorksheet.Cells(lLastRow, 3)).Copy oNewWorksheet.Cells(lLastRow + 1, 2)
74        oNewWorksheet.Range(oNewWorksheet.Cells(2, 5), oNewWorksheet.Cells(lLastRow, 5)).Copy oNewWorksheet.Cells(lLastRow + 1, 4)
75        oNewWorksheet.Range(oNewWorksheet.Cells(2, 1), oNewWorksheet.Cells(lLastRow, 1)).Copy oNewWorksheet.Cells(lLastRow + 1, 1)
76        
77        ' 删除第3列和第5列
78        oNewWorksheet.Columns(5).Delete
79        oNewWorksheet.Columns(3).Delete
80    Next oNewWorksheet
81    
82    ' 保存修改并关闭
83    oNewWorkbook.Save
84    oNewWorkbook.Close
85    Application.ScreenUpdating = True
86    MsgBox "切分通道完成，结果保存在当前文件夹 result 目录下!"
87    
88End Sub