将公式添加到选中的单元格

Question

我正在尝试制作一个代码，用于在用户输入变量或从查找表中计算出一个变量之间切换一行中的单元格。我有一个主要工作，但它运行真的很慢！所以：

• 有关使此代码运行速度更快的建议吗？

• 如何才能使其只查看列中的值（具有自动/手动数据验证下拉列表）更改的单元格？

我已经从下面删除了公式，因为它们有点长。

代码：

Application.ScreenUpdating = False 
Application.AutoCorrect.AutoFillFormulasInLists = False 

'define variables 
Dim Tbl As Range 
Dim RngAuto As Range 
Dim TblRows As Integer 
Dim i As Integer 
Dim cell As Range 

Set Tbl = Range(ActiveSheet.ListObjects(1)) 

TblRows = Tbl.Rows.Count 

'MsgBox ("Warning, proceeding will clear all data for this row!") 

For i = 1 To TblRows 
    If Tbl(i, 8).Text = "Aut" Then 'if set to automatic add formlars to cells 
     Tbl(i, 20).FormulaR1C1 = "Formula Here" 
     Tbl(i, 20).Interior.ColorIndex = 37 

     Tbl(i, 21).FormulaR1C1 = "Formula Here" 
     Tbl(i, 21).Interior.ColorIndex = 37 

     Tbl(i, 22).FormulaR1C1 = "Formula Here" 
     Tbl(i, 22).Interior.ColorIndex = 37 

     Tbl(i, 25).FormulaR1C1 = "Formula Here" 
     Tbl(i, 25).Interior.ColorIndex = 37 

     Tbl(i, 30).FormulaR1C1 = "Formula Here" 
     Tbl(i, 30).Interior.ColorIndex = 37 

     Tbl(i, 31).FormulaR1C1 = "Formula Here" 
     Tbl(i, 31).Interior.ColorIndex = 37 

     Tbl(i, 32).FormulaR1C1 = "Formula Here" 
     Tbl(i, 32).Interior.ColorIndex = 37 

     Tbl(i, 33).FormulaR1C1 = "Formula Here" 
     Tbl(i, 33).Interior.ColorIndex = 37 

     Tbl(i, 34).FormulaR1C1 = "Formula Here" 
     Tbl(i, 34).Interior.ColorIndex = 37 

    Else 
     Set RngAuto = Application.Union(Tbl(i, 20), Tbl(i, 21), Tbl(i, 22), Tbl(i, 25), Tbl(i, 30), Tbl(i, 31), Tbl(i, 32), Tbl(i, 33), Tbl(i, 34)) 

     With RngAuto 
      .Interior.ColorIndex = 0 
      .Select 
     End With 

     For Each cell In Selection 
      cell.Value = cell.Value 
     Next cell 

    End If 

Next i 

Application.ScreenUpdating = True 

End Sub 

在此先感谢。

Answer 1

我希望以下几点更快一点。

Public Sub AutoUpdate() 

Dim strSearchRange As String 
Dim strFirstFound As String 
Dim intLastRow As Integer 
Dim intColumns As Integer 
Dim varFound As Variant 
Dim RngAuto As Range 
Dim cell As Range 
Dim Tbl As Range 


With Application 
    .EnableEvents = False 
    .ScreenUpdating = False 
    .Calculation = xlCalculationManual 
    .AutoCorrect.AutoFillFormulasInLists = False 
End With 

strSearchRange = Range(ActiveSheet.ListObjects(1)).Offset(, 7).Resize(, 1).Address 
intLastRow = ActiveSheet.ListObjects(1).ListRows.Count + 1 

'MsgBox ("Warning, proceeding will clear all data for this row!") 

For Each intColumn In Array(20, 21, 22, 25, 30, 31, 32, 33, 34) 
    With ActiveSheet 
     .Range(.Cells(2, intColumn), .Cells(intLastRow, intColumn)).Interior.ColorIndex = 0 
     .Range(.Cells(2, intColumn), .Cells(intLastRow, intColumn)).Value2 = .Range(.Cells(2, intColumn), .Cells(intLastRow, intColumn)).Value2 
    End With 
Next intColumn 

With Worksheets(1).Range(strSearchRange) 
    Set varFound = .Find("Aut", LookIn:=xlValues) 
    If Not varFound Is Nothing Then 
     strFirstFound = varFound.Address 
     Do 
      ActiveSheet.Range(.Cells(varFound.Row, 20), .Cells(varFound.Row, 22)).FormulaR1C1 = "Formula Here" 
      ActiveSheet.Range(.Cells(varFound.Row, 20), .Cells(varFound.Row, 22)).Interior.ColorIndex = 37 
      ActiveSheet.Range(.Cells(varFound.Row, 25), .Cells(varFound.Row, 25)).FormulaR1C1 = "Formula Here" 
      ActiveSheet.Range(.Cells(varFound.Row, 25), .Cells(varFound.Row, 25)).Interior.ColorIndex = 37 
      ActiveSheet.Range(.Cells(varFound.Row, 30), .Cells(varFound.Row, 34)).FormulaR1C1 = "Formula Here" 
      ActiveSheet.Range(.Cells(varFound.Row, 30), .Cells(varFound.Row, 34)).Interior.ColorIndex = 37 
      Set varFound = .FindNext(varFound) 
     Loop While Not varFound Is Nothing And varFound.Address <> strFirstFound 
    End If 
End With 

With Application 
    .Calculation = xlCalculationAutomatic 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 

End Sub 

请注意，我无法完全测试它。所以，它可能需要一点调整。

我做的事情包括（1）关闭建议的ScreenUpdating和EnableEvents，但也Calculation。 （2）使用.Find函数而不是循环遍历所有行。 （3）使用.value2而不是.value。 （4）通过将它们分组在一起来批量更改公式。