redufa
Sub 插值()

    Dim a
    Dim cout%, i%, k%, r&, c%     \'注意申明变量r要为长整型
    Dim myfile As String, Arr(100) As String, Arr0(100) As String
  
   a = Array(1, 2, 3, 4, 5, 6, 7, 8, 13, 15, 25, 26) \'用数组指定列号
    \'a = Array(1, 2, 4, 6) \'测试用的
    
    c = 29               \'j是相对原始数据的位置(一定要大于列序号的最大值),j相关的两个地方:"=CODE(RC[-3])" ///R[-1]C[-4],RC[-4])
    k = 12             \'k是数组a的维度
               
     Application.Calculation = xlAutomatic   \' 计算选项设置为自动
     fPath = "E:\30-zlzk\(20191115-20200107)52m试验车工地数据-长沙万润\异常查看与检测\data_all\target\csv\"    \'文件路径
    
    
    \'遍历文件夹,提取文件名称
      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

                            
       For i = 0 To k - 1 \'i 第一个是指定列数据
            r = Workbooks(Arr(m)).Sheets(1).Cells(Rows.Count, a(i)).End(xlUp).Row - 1  \'提取第一列最大的列号,考虑函数Resize(),要-1?
               
       with Workbooks(Arr(m)).Sheets(1)
               .Cells(2, c).Resize(r, 1).FormulaR1C1 = "=CODE(RC[-28])" \' 在对应的列输入code公式,这个地方要注意公式引用的位置 C中的值应该为 - j
        
 \'插值
           .Cells(2, c + 1).Resize(r, 1) = "=IF(RC[-1]=32,R[-1]C[-29],RC[-29])"
        
         
 \'复制数据
                .Cells(2, c + 1).Resize(r, 1).Copy
                  .Cells(2, c + 1).PasteSpecial Paste:=xlPasteValues \'在原列进行选择性黏贴
                    .Cells(2, a(i)).Resize(r, 1).Value = Workbooks(Arr(m)).Sheets(1).Cells(2, c + 1).Resize(r, 1).Value  \'把插值后的数据复制到原列
     
  
 \'删除过程数据
  
              .Columns(c).ClearContents
                     .Columns(c + 1).ClearContents
                            .Columns(c + 2).ClearContents
                                  .Columns(1).Select
 \'插值
           .Cells(2, c + 1).Resize(r, 1) = "=IF(RC[-1]=32,R[-1]C[-29],RC[-29])"
        
         
 \'复制数据
                .Cells(2, c + 1).Resize(r, 1).Copy
                  .Cells(2, c + 1).PasteSpecial Paste:=xlPasteValues \'在原列进行选择性黏贴
                    .Cells(2, a(i)).Resize(r, 1).Value = Workbooks(Arr(m)).Sheets(1).Cells(2, c + 1).Resize(r, 1).Value  \'把插值后的数据复制到原列
     
  
 \'删除过程数据
  
              .Columns(c).ClearContents
                     .Columns(c + 1).ClearContents
                            .Columns(c + 2).ClearContents
                                  .Columns(1).Select

   Next
      
      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

 

分类:

技术点:

相关文章: