excel中VBA对多个文件的操作 - jmpep

excel中VBA对多个文件的操作

添加引用 "Scripting.FileSystemObject" (Microsoft Scripting Runtime) \'用于操作文件、目录

Sub 数据整理部分()
\'
\' 数据整理到新的Sheet
\'\'
    Dim fso As New FileSystemObject
    Dim folder As folder
    Dim file As file
    Dim strExt As String
    Dim wkb As Workbook
    
    strExt = "xlsx"     \'查找特定后缀名文件
    Set folder = fso.GetFolder(ThisWorkbook.Path)
    For Each file In folder.Files
        fileExt = fso.GetExtensionName(file)
        
        If fileExt = strExt Then
            Set wkb = Workbooks.Open(file)
            \'原始数据表单移到第一
            Sheets("Sheet1").Move before:=Sheets(1)
            If wkb.Sheets.Count < 2 Then
                wkb.Sheets.Add after:=wkb.Sheets("Sheet1")
            End If
                        
            Dim sheet1 As Worksheet
            Dim sheet2 As Worksheet
            Set sheet1 = wkb.Sheets(1)
            Set sheet2 = wkb.Sheets(2)
            
            Dim dataCount As Long
            dataCount = sheet1.UsedRange.Rows.Count
            \'获取数据行数，添加dt
            sheet2.Range("A1").Value = "dt(s)"
            sheet2.Range("A2:A" & dataCount).Value = 0.0175
            
            subName = "_euler"
            
            If (InStr(file.Name, subName) > 0) Then
                \'符合条件的文件
                wkb.Sheets(2).Name = "euler"
                sheet1.Columns("Q:S").Copy
                sheet2.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                                
            Else
                wkb.Sheets(2).Name = "Sensor"
                \'陀螺仪数据
                sheet1.Columns("AC:AE").Copy
                sheet2.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                \'磁力计数据
                sheet1.Columns("AI:AK").Copy
                sheet2.Range("E1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                \'加速度计数据
                sheet1.Columns("AF:AH").Copy
                sheet2.Range("H1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                \'这里函数加括号会报错！！！
                计算位移部分 sheet2
            End If
        \'关闭excel
        wkb.Save
        wkb.Close
        End If
    Next
    
End Sub
 
Sub 计算位移部分(sheet As Worksheet)
    Dim dataCount As Long
    dataCount = sheet.UsedRange.Rows.Count
    
    \'原始数据积分
    sheet.Range("K1").Value = "Ax(m/s/s)"
    sheet.Range("K2:K" & dataCount).FormulaR1C1 = "=RC8*9.81"
    sheet.Range("L1").Value = "Vx(m/s)"
    sheet.Range("L2").Value = 0
    sheet.Range("L3:L" & dataCount).FormulaR1C1 = "=R[-1]C+RC[-1]*RC1"
    sheet.Range("M1").Value = "Sx(m)"
    sheet.Range("M2").Value = 0
    sheet.Range("M3:M" & dataCount).FormulaR1C1 = "=R[-1]C+RC[-1]*RC1"
    
    \'减去噪声积分
    sheet.Range("K1").Value = "Ax-ave100(m/s/s)"
    sheet.Range("K2:K" & dataCount).FormulaR1C1 = "=(RC8-AVERAGE(R2C8:R101C8))*9.81"
    sheet.Range("L1").Value = "Vx-ave100(m/s)"
    sheet.Range("L2").Value = 0
    sheet.Range("L3:L" & dataCount).FormulaR1C1 = "=R[-1]C+RC[-1]*RC1"
    sheet.Range("M1").Value = "Sx-ave100(m)"
    sheet.Range("M2").Value = 0
    sheet.Range("M3:M" & dataCount).FormulaR1C1 = "=R[-1]C+RC[-1]*RC1"
    
End Sub