从VB.net速度在Excel中循环公式

整个代码说明:

我有这样的代码保存一个txt文件作为一个Microsoft Excel逗号分隔值文件(.csv),然后打开一个名为Graphs表的空白模板excel文件。 然后将所有来自csv文件的数据复制到模板excel文件中,将其重命名为“data”,然后closures后删除csv。 代码然后在“图表”工作表中插入一个图表。 接下来,它将查找图表中使用的总行数以及用于范围引用的列数,然后查找以后的公式。 这个数据是加速度计在特定频率下的加速度。 因此有很多数据,8193行! 数据布局是顶行标签(hz,Part1,2 …),列A是频率,B2的所有其他单元:无论是加速度计读数。

问题是需要83.22秒做下面的循环,插入平均公式:

Do While i <= LastRow 'Assign Range To Take Average CellLeft = wbtempXl.Worksheets("Data").Cells(i, 2) CellRight = wbtempXl.Worksheets("Data").Cells(i, LastColumn) AvgRange = wbtempXl.Worksheets("Data").Range(CellLeft, CellRight) Average = appXL.WorksheetFunction.Average(AvgRange) wbtempXl.Worksheets("Data").Cells(i, LastColumn + 1).Value = Average i = i + 1 Loop 

在这个平均公式之后,我添加了峰值search逻辑来查找数据中的峰值和谷值,但是这一步需要一分半钟。 有没有更快,更好的方法呢? 循环公式是。

注意:我不能在模板中使用公式。 testing可能包括12个部分或100个部分。 每个部分都有自己的列,频率在列A的行中。其余的行是每个频率的加速度读数。 会张贴图片,但不允许。

完整代码:

 Public Sub btn_Do_Click(sender As Object, e As EventArgs) Handles btn_Do.Click Dim FileTXT As String = cbo_FileList.Text Dim folderpath As String = "C:\Users\aholiday\Desktop\Data Dump" Dim txtpath As String = folderpath & "\" & FileTXT & ".txt" Dim csvpath As String = "C:\Temp\" & FileTXT & ".csv" Dim FinalFile As String = "C:\Users\aholiday\Desktop\Test" Try File.Copy(txtpath, csvpath) Catch MsgBox("Please Choose File") Exit Sub End Try appXL = CreateObject("Excel.Application") appXL.Visible = True wbcsvXl = appXL.Workbooks.Open(csvpath) wbtempXl = appXL.Workbooks.Open(FinalFile) wbcsvXl.Worksheets(FileTXT).Copy(After:=wbtempXl.Worksheets("Graphs")) wbtempXl.Worksheets(FileTXT).Name = ("Data") 'Close Objects wbcsvXl.Close() File.Delete(csvpath) 'Release Objects wbcsvXl = Nothing ' Declare Varables Dim Chart As Excel.Chart Dim ChartXL As Excel.ChartObjects Dim ThisChart As Excel.ChartObject Dim SerCol As Excel.SeriesCollection Dim Series As Excel.Series Dim xRange As Excel.Range Dim xCelltop As Excel.Range Dim xCellBottom As Excel.Range Dim yRange As Excel.Range Dim yCelltop As Excel.Range Dim yCellBottom As Excel.Range Dim CellRight As Excel.Range Dim CellLeft As Excel.Range Dim AvgRange As Excel.Range Dim Average As Double Dim LastRow As Long Dim LastColumn As Long Dim i As Integer ' Set i integer i = 2 'Make Chart ChartXL = wbtempXl.Worksheets("Graphs").ChartObjects ThisChart = ChartXL.Add(0, 0, 800, 400) Chart = ThisChart.Chart Chart.ChartType = Excel.XlChartType.xlXYScatterSmoothNoMarkers With ThisChart.Chart .HasTitle = True .ChartTitle.Characters.Text = "RF Graph" ' X,Y title?????? End With 'Count Rows Used 'Find last Row Used With wbtempXl.Worksheets("Data") LastRow = .UsedRange.Rows.Count End With 'Count Columns Used 'Find Last Column Used With wbtempXl.Worksheets("Data") LastColumn = .UsedRange.Columns.Count End With Do Until i > LastColumn 'Excel Chart X Axis Values xCelltop = wbtempXl.Worksheets("Data").Cells(2, 1) xCellBottom = wbtempXl.Worksheets("Data").Cells(LastRow, 1) xRange = wbtempXl.Worksheets("Data").Range(xCelltop, xCellBottom) 'Excel Chart Y Axis Values yCelltop = wbtempXl.Worksheets("Data").Cells(2, i) yCellBottom = wbtempXl.Worksheets("Data").Cells(LastRow, i) yRange = wbtempXl.Worksheets("Data").Range(yCelltop, yCellBottom) 'Label Part in Data Sheet wbtempXl.Worksheets("Data").Cells(1, i).Value = ("Rotor " & i - 1) 'Add New Series to Chart SerCol = Chart.SeriesCollection Series = SerCol.NewSeries 'Rename and Assign Values With Series .Name = ("Rotor " & i - 1) Series.XValues = xRange Series.Values = yRange End With Chart.Refresh() i = i + 1 Loop 'Add Average Column Label wbtempXl.Worksheets("Data").Cells(1, LastColumn + 1).Value = "Average" 'Rest i integer i = 2 Do While i <= LastRow 'Assign Range To Take Average CellLeft = wbtempXl.Worksheets("Data").Cells(i, 2) CellRight = wbtempXl.Worksheets("Data").Cells(i, LastColumn) AvgRange = wbtempXl.Worksheets("Data").Range(CellLeft, CellRight) Average = appXL.WorksheetFunction.Average(AvgRange) wbtempXl.Worksheets("Data").Cells(i, LastColumn + 1).Value = Average i = i + 1 Loop 'Release Objects wbtempXl = Nothing appXL = Nothing GC.Collect() Me.Close() End Sub 

我build议你把公式放在单元格中,然后根据需要转换成值:

  With wbtempXl.Worksheets("Data") formularange = .Range(.Cells(i, LastColumn + 1), .Cells(LastRow, LastColumn + 1)) End With formularange.FormulaR1C1 = "=AVERAGE(RC2:RC[-1])" formularange.Value2 = formularange.Value2