對應力資料進行清零

Sub 清零修正()
    Dim a
     
    Dim cout%   '注意申明變數r要為長整型
   Dim myfile As String, Arr(100) As String, Arr0(100) As String, arr1(10) As String
   
    On Error Resume Next
         
   
 '清零值'

M1C1 = 1603: M1C2 = 1211: M1C3 = 3457: M1C4 = 2956:
M2C1 = -262: M2C2 = 2572: M2C3 = 2325: M2C4 = 1009:

M4C1 = 1088: M4C3 = 1076:
   

arr1(1) = M1C1: arr1(2) = M1C2: arr1(3) = M1C3: arr1(4) = M1C4:
arr1(5) = M2C1: arr1(6) = M2C2: arr1(7) = M2C3: arr1(8) = M2C4:
arr1(9) = M4C1: arr1(10) = M4C3:

    

               
     Application.Calculation = xlAutomatic   ' 計算選項設定為自動
     fPath = "E:\載荷譜資料彙總\小樣本\"    '檔案路徑   ' 這個地方要記得加\
    
    
    '遍歷資料夾，提取檔名稱
      myfile = Dir(fPath & "*.csv")    '注意資料檔案的格式

      cout = cout + 1
      Arr0(cout) = myfile
      Name fPath & myfile As fPath & 1 & ".csv"
      Arr(cout) = cout & ".csv"
    
    Do While myfile <> ""
        myfile = Dir
        If myfile = "" Then
            Exit Do
        End If
        cout = cout + 1
        Arr0(cout) = myfile         '將最初檔名稱存在陣列
        Name fPath & myfile As fPath & cout & ".csv"  '修改檔名
       Arr(cout) = cout & ".csv"      '把修改的檔名存在另一個數組
  
    Loop
    
    
    
    Debug.Print "總共表格數：" & cout
      Debug.Print cout & ".csv"
    
         
    
 For m = 1 To cout
        Workbooks.Open Filename:=fPath & Arr(m)    '迴圈開啟Excel檔案
        Debug.Print "開啟的" & m & "個表格，名稱為" & Arr(m)
  
       Application.ScreenUpdating = False
      
      
        With Workbooks(Arr(m)).Sheets(1)
      
               '統計資料的行數'
        
             'n = ActiveSheet.UsedRange.Rows.Count
              n = Workbooks(Arr(m)).Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        
        
               Debug.Print n  ' 輸出行數

                For i = 1 To 10
                
                
                .Cells(2, 30).Resize(n - 1, 1) = arr1(i)
                
                Debug.Print arr1(i)
                
                
                .Cells(2, 30).Resize(n - 1, 1).Copy
                
                 .Cells(2, i).Resize(n - 1, 1).PasteSpecial .Cells(2, 1), xlPasteSpecialOperationAdd, False, False
                 Application.CutCopyMode = False
                
                
                
                .Cells(2, 30).Resize(n - 1, 1).Delete
                
                
                
                Next

              
        End With
        
        
        Application.ScreenUpdating = ture

        Application.DisplayAlerts = False
       ActiveWorkbook.Save
        ActiveWorkbook.Close savechanges = True     '關閉開啟的檔案
        ' Application.Quit   退出excel
  
      Debug.Print "完成操作"


  Next
  
  

For i = 1 To cout
       Name fPath & i & ".csv" As fPath & Arr0(i)
Next
 
Debug.Print "所有資料全部完成"
 
 

End Sub


Sub dd()
       
                   
For i = 1 To 10


.Cells(2, 30 + i).Resize(n - 1, 1) = arr1(i)


.Cells(2, 30 + i).Resize(n - 1, 1).Copy

 .Cells(2, i).Resize(2, i).PasteSpecial .Cells(2, i), xlPasteSpecialOperationAdd, False, False
 Application.CutCopyMode = False



.Cells(2, 30 + i).Resize(n - 1, 1).Delete


Next
 
End Sub