清零程序

对应力数据进行清零
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
清零程序

推荐阅读
