vba 宏获取文件夹中所有excel文件,对slk文件数据每3000个求平均值

功能：此宏用于处理excel数据，一个文件夹中保存了大约200个slk文件，每个文件中一般是30000个数据。代码获取文件夹中所有slk文件，每

3000个数据求平均值，将平均值保存在一个xls文件中，并自动生成散点图，用于数据分析。

      vba源码如下:

Sub average()
Dim myPath$, myFiles() As String, arr() As String, myFile$, xlApp, filelog, n%, timegap As Single, total As Double, Circulation%, group%, current%
group = 3000
group = Application.InputBox(prompt:="请输入每几个数求平均值", Type:=1, Default:=3000)
current = group - 1
total = 0
With Workbooks(1).Sheets.Add
.Name = "临时文件"
End With
 Set filelog = Application.FileDialog(msoFileDialogFolderPicker)
If filelog.Show = True Then
myPath = filelog.SelectedItems(1)
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
myFile = Dir(myPath & "/*.slk") '依次找寻指定路径中的*.slk文件
If myFile <> "" Then
n = 1

ReDim arr(1 To 1)

Do While myFile <> "" '将文件名存入数组
If n > 1 Then
For i = 1 To n - 1
arr(i) = myFiles(i)
Next i
End If
arr(n) = myFile
ReDim myFiles(1 To n)
myFiles = arr
n = n + 1
ReDim arr(1 To n)
myFile = Dir
Loop
n = n - 1
If n >= 2 Then '文件名按升序排列
For i = 1 To n - 1
For j = i + 1 To n
If Val(Replace(myFiles(i), "_part", "")) > Val(Replace(myFiles(j), "_part", "")) Then
myFile = myFiles(i)
myFiles(i) = myFiles(j)
myFiles(j) = myFile
End If
Next j
Next i
End If

Cells(1, 1) = 3
Cells(1, 2) = 0
Application.Workbooks.Open (myPath & "/" & myFiles(1))
timegap = Workbooks(2).Sheets(1).Cells(3001, 1) - Workbooks(2).Sheets(1).Cells(1, 1)
Workbooks(2).Close True
For j = 1 To n
Application.Workbooks.Open (myPath & "/" & myFiles(j)) '依次打开SLK文件

Workbooks(2).Sheets(1).Activate

current = group - current
Circulation = current
With Workbooks(1).Sheets("临时文件")
If current <> 1 Then

 .Range("a65536").End(xlUp).Offset(1).Value = (total + Application.WorksheetFunction.Sum(Cells(1, 2).Resize(current - 1))) / group
.Range("b65536").End(xlUp).Offset(1).Value = .Range("b65536").End(xlUp).Value + timegap
End If
For i = 1 To (Range("b65536").End(xlUp).row - Circulation + 1) / group
.Range("a65536").End(xlUp).Offset(1).Value = Application.WorksheetFunction.average(Cells(current, 2).Resize(group))
.Range("b65536").End(xlUp).Offset(1).Value = .Range("b65536").End(xlUp).Value + timegap
current = current + group
Next i
End With
If Range("a65536").End(xlUp).row = current - 1 Then
total = 0
current = group - 1

Else
total = Application.WorksheetFunction.Sum(Range("b" & current & ":b" & Range("b65536").End(xlUp).row))
current = Range("a65536").End(xlUp).row - current
End If
Workbooks(2).Close False
Next j
Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
Cells(1, 1).Delete
Range("b65536").End(xlUp).Delete
Charts.Add
With ActiveChart
  .ChartType = xlXYScatter
  .SeriesCollection.NewSeries
  .SeriesCollection(1).XValues = Sheets("临时文件").Range("b1:" & Sheets("临时文件").Range("b65536").End(xlUp).Address)
  .SeriesCollection(1).Values = Sheets("临时文件").Range("a1:" & Sheets("临时文件").Range("a65536").End(xlUp).Address)

  .Location Where:=xlLocationAsObject, Name:="临时文件"
  End With
    With ActiveChart
       .HasTitle = True
        .ChartTitle.Characters.Text = "蠕变图"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "时间"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "数据"
    End With
    ActiveChart.HasLegend = False
Application.Workbooks.Add
Application.DisplayAlerts = False
Workbooks(2).Sheets(1).Delete
Application.DisplayAlerts = False
Workbooks(1).Sheets("临时文件").Move before:=Workbooks(2).Sheets(1)
Application.DisplayAlerts = False
Workbooks(2).Sheets(1).Name = "Sheet1"
Workbooks(2).SaveAs myPath & "/处理结果.xls"
MsgBox "完成!"
Else
MsgBox "该目录没有slk文件!"
End If
Else
Application.DisplayAlerts = False
Worksheets("临时文件").Delete
Application.DisplayAlerts = True
End If
End Sub