3

我有这个函数，它根据左侧单元格的值更新单元格。不幸的是，我不得不在函数结束之前添加最后一行代码，这样当我单击按钮运行宏时，工作表会向上滚动，每个单元格都被选中，这使得它向下滚动到最后一行数据（600 行）。

如果您能告诉我如何避免这种情况，将不胜感激。

代码是：

Sub Button2_Click()
Dim regExM As New RegExp
Dim regEx As New RegExp
Dim matches, level

regExM.Pattern = "(M)(\d)"
regEx.Pattern = "[^-](.{0})(\d)"
regExM.Global = False

  Range("J2").Activate
  ' Set Do loop to stop when an empty cell is reached.
  Do Until IsEmpty(ActiveCell)
     If regExM.Test(ActiveCell.Value) Then
        Set matches = regExM.Execute(ActiveCell.Value)
        For Each Match In matches
            level = matches(0).SubMatches(1) + 3
            ActiveCell.Offset(0, 1).Value = level
        Next
     ElseIf regEx.Test(ActiveCell.Value) Then
        Set matches = regEx.Execute(ActiveCell.Value)
        For Each Match In matches
            level = matches(0).SubMatches(1)
            ActiveCell.Offset(0, 1).Value = level
        Next
     End If
     ' Step down 1 row from present location.
     ActiveCell.Offset(1, 0).Activate
  Loop
  Range("A1").Select
End Sub

谢谢

4

2 回答 2

5

您可以在宏运行时关闭屏幕更新。

Sub Button2_Click()
Application.ScreenUpdating = False
 '...code
  Range("A1").Select
Application.ScreenUpdating = True
End Sub
于 2013-07-03T12:52:10.883 回答
3

我认为没有必要激活细胞。只需遍历范围并使用这些值执行您需要的操作。这应该更快，并且避免在运行时移动工作表。

Option Explicit

Sub Button2_Click()
Dim regExM As New RegExp
Dim regEx As New RegExp
Dim matches, level
Dim lr As Long
Dim i As Long

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


lr = ActiveSheet.UsedRange.Rows.Count

regExM.Pattern = "(M)(\d)"
regEx.Pattern = "[^-](.{0})(\d)"
regExM.Global = False


  For i = 2 To lr
     If regExM.Test(Range("J" & i).Value) Then
        Set matches = regExM.Execute(Range("J" & i).Value)
        For Each Match In matches
            level = matches(0).SubMatches(1) + 3
           Range("J" & i).Offset(0, 1).Value = level
        Next
     ElseIf regEx.Test(Range("J" & i).Value) Then
        Set matches = regEx.Execute(Range("J" & i).Value)
        For Each Match In matches
            level = matches(0).SubMatches(1)
            Range("J" & i).Offset(0, 1).Value = level
        Next
     End If
    Next i

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
于 2013-07-03T12:50:16.033 回答