在选择时将公式添加到单元格

时间:2015-05-21 09:04:56

标签: excel vba excel-vba

我正在尝试创建一个代码,用于在用户输入变量或从查找表计算的变量之间切换单元格。我有一个主要工作,但它运行得非常慢!所以:

  • 有关使此代码运行得更快的任何建议吗?

  • 如何才能让它只查看列中的值(带有自动/手动数据验证下拉列表)的单元格?

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

代码:

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

提前致谢。

1 个答案:

答案 0 :(得分:0)

我希望以下内容更快一些。

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)关闭建议的ScreenUpdatingEnableEvents以及Calculation。 (2)使用.Find函数而不是遍历所有行。 (3)使用.value2代替.value。 (4)通过将它们组合在一起来批量改变公式。