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

Whole Code Explained:

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

The Problem 执行以下循环需要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

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值