我正在尝试创建一个代码,用于在用户输入变量或从查找表计算的变量之间切换单元格。我有一个主要工作,但它运行得非常慢!所以:
有关使此代码运行得更快的任何建议吗?
如何才能让它只查看列中的值(带有自动/手动数据验证下拉列表)的单元格?
我已经从下面删除了公式,因为它们有点长。
代码:
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
提前致谢。
答案 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)关闭建议的ScreenUpdating
和EnableEvents
以及Calculation
。 (2)使用.Find
函数而不是遍历所有行。 (3)使用.value2
代替.value
。 (4)通过将它们组合在一起来批量改变公式。