Looping формула в Excel От VB.net Скорость

Question

весь код Разъяснения:

Я этот код, который сохраняет текстовый файл в Microsoft Excel Значения, разделенные запятыми файл (CSV), а затем открывает пустой шаблон первенствует файл с листом с именем Graphs. Затем он копирует лист со всеми данными из файла csv в файл excel шаблона, переименовывает его в «данные». Затем удаляет csv после закрытия. Затем код вставляет диаграмму в лист «graph». Затем он находит общее количество используемых строк и количество столбцов, используемых для ссылок для диапазонов в графах, а затем для последующих формул. Эти данные - ускорение с акселерометра с определенной частотой. Поэтому есть много данных, 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 

После этой Ср формулы я добавление пика ознакомительной логики, чтобы найти пики и впадины в данные, но только этот шаг занимает минуту и ​​полтора. Есть ли быстрый, лучший способ сделать это? Циклические формулы, которые есть.

Примечание: Я не могу просто иметь формулы в шаблоне. Тест может включать 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 

Answer 1

Я предлагаю вам поместить формулы в ячейках с кодом затем преобразовать в значение, если требуется:

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