时间戳

首页 > 解决方案 > 高效地迭代 50 多个资产，然后分别创建每个资产值的工作表

excel - 高效地迭代 50 多个资产，然后分别创建每个资产值的工作表

问题描述

我录制了一个宏来更好地理解我的过程。该宏在下面的第一部分中显示。第二部分是我试图让这件事变得更快的尝试。

当前事件顺序

  1. 在单元格 D3 中的标题为“实时”的选项卡中插入资产名称（单元格 D3 是一个包含 50 多个资产的下拉列表 - 下一节标题为“我们可以改进的步骤”中的更多内容）
  2. 使用 Application.CalculateFull 计算新资产
  3. 等到“实时”选项卡完成计算以移动到下一行代码
  4. 等待 15 秒（下一节将详细介绍）
  5. 在“实时”选项卡中复制新迭代的数据
  6. 创建一个以资产名称为标题的新工作表
  7. 将“实时”选项卡中的数据作为值粘贴到新创建的工作表中
  8. 重复步骤 1-7，直到计算完所有资产

改进步骤

  1. 而不是在单元格 D3 中插入​​资产名称，这需要大量代码，我想遍历单元格 D3 中找到的列表（一个数据验证列表，它从另一个工作表的主列表中获取资产名称）。
  1. 我在代码中添加了时间，因为我认为模型没有完全迭代某些资产。这是错误的——它永远不会随着时间的增加而正确迭代。那么，很可能是公式错误？下面列出了该公式，它显示了大约 20 个资产的 #VALUE 错误 - 但仅在我运行宏时。在宏之外，此公式会正确填充。
Sub SlowMACROv3()

  ' Turns off screen updating and auto calcs which helps to speed macro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

  ' Turns off screen updating and auto calcs which helps to speed macro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual    

    Sheets("Live").Select
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "309"
    Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
    Application.Wait (Now + TimeValue("0:00:15"))
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    Sheets("Live").Select
    Sheets("Live").Copy Before:=Sheets(1)
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "310"
    Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
    Application.Wait (Now + TimeValue("0:00:15"))
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

  ' Turns on screen updating and auto calcs
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

我的第二次尝试有效，但代码也一样长。此外，公式会为某些资产引发错误，并且可以在最底部找到。

Sub SlowishMACROv1()

  ' Turns off screen updating and auto calcs which helps to speed macro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

  ' Cycle all assets and create new worksheets as values macro
    Sheets("Live").Copy Before:=Sheets(1)
    Range("D3").FormulaR1C1 = "309"
    Application.Calculate
    If Not Application.CalculationState = xlDone Then DoEvents
    Range("A1:XFD1000").Value = Range("A1:XFD1000").Value

    Sheets("Live").Copy Before:=Sheets(1)
    Range("D3").FormulaR1C1 = "310"
    Application.Calculate
    If Not Application.CalculationState = xlDone Then DoEvents
    Range("A1:XFD1000").Value = Range("A1:XFD1000").Value

  ' Turns on screen updating and auto calcs
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic     

End Sub

Formula: =+IF(INDEX('Reversion Dashboard'!$I:$I,MATCH($D$3,'Reversion Dashboard'!$C:$C,0))=1,I331*(1+(RATE($E$325,,$I331,-('Reversion Schedule'!$K$19)))),"")

此公式在“实时”选项卡中有效，但在运行宏时触发 IF True 部分中 =1 部分的资产除外。为什么每次我们切换到不同的资产时这个公式都有效，但在我运行宏时却无效？

标签： excelvba

解决方案

由于评论很长，我很想建议您关闭此问题并重新开始。阅读 [ask] 和 [mcve] 并可能发布屏幕截图，因为请记住我们对您的设置一无所知。

但是，看看这段代码是否能广泛地满足你的要求——正如 Ibo 所说，这并不完全清楚。

Sub x()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim r As Range, ws As Worksheet

For Each r In Worksheets("Asset Dashboard").Range("C6:C570") 'go through each cell in DV list
    If Len(r) > 0 Then                                       'only do something if cell not empty
       Worksheets("Live").Range("D3").Value = r.Value           'transfer value to D3 of Live
       Application.Calculate
       Set ws = Worksheets.Add                                  'add new sheet
       Worksheets("Live").UsedRange.Copy
       ws.Range("A1").PasteSpecial xlValues                     'copy values only from Live to new sheet
    End if
Next r

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

推荐阅读