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