Question

整个代码解释：

我有这个代码将txt文件保存为Microsoft Excel逗号分隔值文件（.csv），然后打开一个空白模板excel文件，其中包含一个名为Graphs的工作表。然后它将包含csv文件中所有数据的工作表复制到模板excel文件中，将其重命名为＆＃34; data＆＃34;然后在关闭后删除csv。然后代码在＆＃34;图表＆＃34;中插入图表。片。接下来，它会查找使用的总行数和用于图表中范围的引用的列数，然后查找以后的公式。该数据是来自特定频率的加速度计的加速度。因此有很多数据，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

来自VB.net的Excel中的循环公式

1 个答案: