Question

现在我使用波纹管代码在给定日期范围之间按小时生成所有日期。然后在第16行中有公式复制到第18行，然后每个公式自动填充到列А中的最后一个日期。日期用于公式中。代码工作正常，但一次计算和更新所有公式的工作速度很慢。我想问题是因为第17行之后的每个单元格都是公式。所以现在我想知道有没有办法编辑代码来计算每个时间间隔的第16行中的每个公式，并将结果作为值从第18行复制到最后一行，日期在A列。

Option Explicit
Sub TEST()
'Updated on 02-10-2017
Application.Calculation = xlManual
    Application.StatusBar = "Getting Daily Results...."
    Application.ScreenUpdating = False
ActiveSheet.Rows(18 & ":" & ActiveSheet.Rows.Count).ClearContents
Rows("16:16").Copy Destination:=Rows("18:18")
Range("A18", Range("A18").End(xlDown)).Clear
Dim rng As Range
Dim StartRng As Range
Dim EndRng As Range
Dim OutRng As Range
Dim IntvlHrsRng As Range
Dim IntvlHrs As Long
Dim StartValue As Variant
Dim EndValue As Variant
Const xTitleId As String = "KutoolsforExcel"
Dim ColIndex As Long
Dim I As Long
Dim ic As Long
Dim LastRow As Long
Dim LastRowDB As Long
Set StartRng = Application.Selection
Set StartRng = Range("B3")
Set EndRng = Range("B4")
Set IntvlHrsRng = Range("B5")
Set OutRng = Range("A18")
Set OutRng = OutRng.Range("A1")
StartValue = StartRng.Range("A1").Value
EndValue = EndRng.Range("A1").Value
IntvlHrs = IntvlHrsRng.Range("A1").Value
    If IntvlHrs = 0 Then IntvlHrs = 24

If EndValue - StartValue <= 0 Then
    Exit Sub
    End If
    ColIndex = 0

    For I = StartValue * 24 To EndValue * 24 Step IntvlHrs
        OutRng.Offset(ColIndex, 0) = I / 24
        OutRng.Offset(ColIndex, 0).NumberFormat = "dd/mm/yyyy hh:mm"
        ColIndex = ColIndex + 1
    Next I

LastRow = Range("A" & Rows.Count).End(xlUp).Row
LastRowDB = Range("C" & Rows.Count).End(xlUp).Row

If LastRowDB >= LastRow Then
    Exit Sub
    End If

For ic = 2 To 99

    Cells(LastRowDB, ic).AutoFill Destination:=Range(Cells(LastRowDB, ic), Cells(LastRow, ic))

Next ic

ActiveSheet.Calculate
    Application.StatusBar = "Ready"
    Application.ScreenUpdating = True
End Sub

VBA使用公式计算行并将答案粘贴为另一行中的值

0 个答案: