Question

我正致力于创建一个查找出发和到达时间的计划工具，并创建一个可视化工具。我有1440列，每天每分钟一个，我写了一个公式来比较分段时间，出发时间和到达时间到该列的分钟，我在第1行中指出。该公式看起来像这样：

= IFERROR（IF（AND（W $ 1·[出发]，W $ 1 GT; = [阶段]）， “STAGE”，IF（AND（W $ 1 GT; = [出发]，W $ 1·= [到达]），“在服务中”，“”）），“”）

然后我使用条件格式来突出显示不同颜色的术语“舞台”和“使用中”。当列宽减小到几个像素时，这提供了很好的视觉调度收费。

我听到最终用户的问题是，这个公式，720,000次，需要相当多的内存。我想知道是否有办法通过编写一个vba来减少文件大小，该vba将在不使用时删除公式并在需要时将它们放回去。

谢谢！

Answer 1

您应该使用公式＆amp;复制细胞。然后使用相同的范围使用.PasteSpecial xlPasteValues。这将用它们产生的值替换公式。然后，您应该在工作表的代码中加入一些逻辑，这样当[Depart]，[Stage]，＆amp; /或[Arrival]的值发生变化时，公式将被重新应用，计算，和然后再次删除。这样A）你将公式保存在代码中，不会被意外删除; B）用户不必做任何额外的事情来启动更新。

我将假设Depart / Arrival / Stage时间从B2开始，并且在一列中，1440列从D列开始。鉴于此，您需要以下内容：

Private Sub Worksheet_Change(ByVal Target As Range)
'
'Confirm the target is for the Depart/Arrival/Stage values & we didn't just empty the cell
If Target.Column = "B" AND Target.Value <> "" THEN
    Dim r as long
    r = Target.Row
    'Remove old values to be sure we don't carry over anything from the row's prior value
    Range("D" & r & ":BCM" & r).ClearContents
    Range("D" & r).Formula= "[insert your formula here]"

    'Paste the formulas to the rest of the range
    Range("E" & r & ":BCM" & r).PasteSpecial xlPasteFormulas
    'Calculate so we have correct values
    Range("D" & r & ":BCM" & r).Calculate

    'Replace the formulas with values
    Range("D" & r & ":BCM" & r).Copy
    Range("D" & r & ":BCM" & r).PasteSpecial xlPasteValues
End If 'else do nothing, not in the correct range (prevents infinite loops)

End Sub

你可能需要做一些调整来解释哪些数据在哪里？更新如何完成（例如，如果您一次添加/删除多次，您将希望像我一样将公式应用于第一个单元格，但随后将其应用于整个受影响的范围，行和列，一步而不是一行一次。

Answer 2

感谢您输入所有内容，

有时最好的解决方案是最简单的。我使用了记录宏功能并重建了我的图表。我添加了几个屏幕更新命令，效果很好。如果您有兴趣，请参阅下面的代码。

感谢。

Sub ActiveGantt()
Application.ScreenUpdating = False

If Range("H1") = "OFF" Then

    Sheets("Sheet1").Select
    Range("W4").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(AND(R1C<RC21,R1C>=RC20),""STAGE"",IF(AND(R1C>=RC21,R1C<=RC22),""IN SERVICE"","""")),"""")"
    Range("W4").Select
    Selection.AutoFill Destination:=Range("W4:W717"), Type:=xlFillDefault
    Range("W4:W717").Select
    Selection.AutoFill Destination:=Range("W4:BDF717"), Type:=xlFillDefault
    Range("W4:BDF717").Select
    Selection.End(xlUp).Select

     Range("W4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy

    Range("W4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("h1").Value = "ON"


Else

    Sheets("Sheet1").Select
    Range("W4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
    Selection.End(xlUp).Select
    Range("U3").Select
    Selection.End(xlToLeft).Select

    Range("h1").Value = "OFF"



Application.ScreenUpdating = True

End If

End Sub

有没有办法编写一个可以填充大量连续公式的VBA？

2 个答案: