【021】整理力学拉伸实验数据（复制、黏贴、计算）_#VBA

1. 需求

2. 实现流程

2.1 流程图

流程如上，因测试得到多个数据表格，先将表格数据合并，并以文件名作为每个数据的代号。然后更换坐标轴，通过对文件名数据的处理，得到最终曲线的数据。

2.2 运行方法

First: 打开下载的Excel文件，点击 视图—>宏—>查看宏

Second: 弹出如下界面后，点击 编辑，弹出代码对话框，在红色框内输入对应的数据文件夹


**Third:**在宏的界面，依次点击 “整理所有数据放在总表内” / “切换坐标轴” / “对数据进行计算”，然后点击执行即可

2.3 完整代码

Sub 整理所有数据放在总表内()

    Application.DisplayAlerts = False
    ' 关闭信息提示弹窗
    
    Dim MyFile As String
    Dim erow As Long
    Dim Filepath As String
    erow = 1
    Filepath = "E:\课题进度\待完成工作\现阶段工作\隔膜分析\2. 测试数据\2022-10-12-圆柱型电池测试\2. 物理性能\拉伸\2023-10-13-MD-TD对比\" '设置需要遍历的文件夹路径
    MyFile = Dir(Filepath)
    
    Do While Len(MyFile) > 0
        If MyFile = "Master.xlsm" Then GoTo NextFile '跳过当前工作表
        Workbooks.Open (Filepath & MyFile)
        
        '提取数据
        LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
        Range("B2:C" & LastRow).Copy
        
        '粘贴到总表
        
        Sheet1.Cells(1, 2 * erow - 1) = MyFile '在第一列写入文件名
        Sheet1.Cells(2, 2 * erow - 1).PasteSpecial
        
        Workbooks(MyFile).Close
        SaveChanges = False
        erow = erow + 1
NextFile:
        MyFile = Dir()
    Loop

End Sub

Sub 切换坐标轴()

    For i = 1 To 30
        Sheets("Sheet1").Select
        Range(Columns(2 * i - 1), Columns(2 * i - 1)).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Cells(1, 2 * i).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
        Range(Columns(2 * i), Columns(2 * i)).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Cells(1, 2 * i - 1).Select
        ActiveSheet.Paste
    Next
    
End Sub

Sub 对数据进行计算()

    Dim sh2Data As Variant, sh3Data As Variant
    Dim result(100000, 60) As Double
    Dim i As Long, j As Long, k As Long
    
    '读取Sheet2数据到数组
    sh2Data = Sheets("Sheet2").UsedRange
    
    '读取Sheet3数据到数组
    sh3Data = Sheets("Sheet3").UsedRange
    
    '根据Sheet3矩阵进行运算
    For i = 1 To 25
      For j = 4 To Sheets("Sheet2").Cells(Rows.Count, i * 2).End(xlUp).Row
        result(j, 2 * i - 1) = sh2Data(j, 2 * i - 1) / sh3Data(i, 2)
        result(j, 2 * i) = sh2Data(j, 2 * i - 1) / sh3Data(i, 3)
      Next j
    Next i
    
    '将结果写入Sheet4
    Sheets("Sheet4").Range("A1").Resize(UBound(result, 1), UBound(result, 2)).Value = result
    For i = 1 To 25
      Sheets("Sheet4").Cells(1, 2 * i) = sh2Data(1, 2 * i)
      Sheets("Sheet4").Cells(2, 2 * i) = "strain"
      Sheets("Sheet4").Cells(2, 2 * i + 1) = "stress"
      Sheets("Sheet4").Cells(3, 2 * i + 1) = "MPa"
    Next
    
End Sub