excel中VBA对多个文件的操作

时间：2024-04-06 20:34:36

添加引用 "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()

            If wkb.Sheets.Count <  Then

                wkb.Sheets.Add after:=wkb.Sheets("Sheet1")

            End If

            Dim sheet1 As Worksheet

            Dim sheet2 As Worksheet

            Set sheet1 = wkb.Sheets()

            Set sheet2 = wkb.Sheets()

            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) > ) Then

                '符合条件的文件

                wkb.Sheets().Name = "euler"

                sheet1.Columns("Q:S").Copy

                sheet2.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            Else

                wkb.Sheets().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 =

    sheet.Range("L3:L" & dataCount).FormulaR1C1 = "=R[-1]C+RC[-1]*RC1"

    sheet.Range("M1").Value = "Sx(m)"

    sheet.Range("M2").Value =

    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 =

    sheet.Range("L3:L" & dataCount).FormulaR1C1 = "=R[-1]C+RC[-1]*RC1"

    sheet.Range("M1").Value = "Sx-ave100(m)"

    sheet.Range("M2").Value =

    sheet.Range("M3:M" & dataCount).FormulaR1C1 = "=R[-1]C+RC[-1]*RC1"

End Sub

相关文章