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