计算机因简单代码而窒息。我错过了什么？

Question

此宏在 col B 中搜索“检查”数字 (IsNumeric)，找到后将数字偏移 (0,2)，然后将原始单元格中的数字替换为“检查”。

当使用lastrow 作为规则时，它的运行速度非常慢（尽管如果我将范围设为一整列，即“B:B”，也会同样慢）。

这两种不同方法之间的唯一区别是lastrow 规则将“检查”添加到最后一行，一直到工作表的最后一行。我整天都在黑客攻击，通常这样的事情不会让我陷入困境（双关语）。

Sub Move_Checks()
    
    Dim ws1 As Worksheet
    Set ws1 = Sheets("Combined")
   
   Dim lastrow As Long
     lastrow = Cells(Rows.Count, "a").End(xlUp).row
    
   Dim rng1 As Range
    Set rng1 = Range("B:B") 
    
    Dim Cell As Range
    Set Cell = Range("B2" & lastrow)
    
            For Each Cell In rng1
               If IsNumeric(Cell.value) = True Then
                  Cell.Offset(0, 3) = Cell.value
                            
            End If
                        
        Next Cell
     
            For Each Cell In rng1
             If IsNumeric(Cell.value) = True Then
                 Cell.value = "Check"
    
            End If
    
        Next Cell


End Sub

Answer 1

试试这个修改后的代码。

您不需要两个循环，您可以一次完成更改。

您的 rng1 变量设置为整个 B 列。

您几乎将Cell 变量设置为实际上是正确的Range，但随后在循环通过Range 时将其用作每个单元格的占位符来覆盖它。

Sub Move_Checks()
    
    Dim ws1 As Worksheet
    Dim rng1 As Range
    Dim Cell As Range
    Dim lastrow As Long

    Set ws1 = Sheets("Combined")

    lastrow = ws1.Cells(Rows.Count, "a").End(xlUp).row

    Set rng1 = Range("B2:B" & lastrow)
    
    For Each Cell In rng1
        If IsNumeric(Cell.value) = True Then
            Cell.Offset(0, 3) = Cell.value
            Cell.value = "Check"            
        End If               
    Next Cell
     
End Sub

Answer 2

使用条件替换查找

• 将代码复制到标准模块中（例如Module1）。
• 调整 constants 部分中的值，包括 工作簿。
  • 请特别注意目标列 TargetCol，这是将写入数值的列，因为它只是通过 2 或 3 列偏移量隐式提及的。
  • 如果您将运行此代码以将更改应用到另一个工作簿，请适当更改 ThisWorkbook。 ThisWorkbook'表示'包含此代码的工作簿。
  • 列被声明为Variant 以便能够使用字符串或数字来引用它们，即您可以使用1 或"A"、2 或"B" ...等。李>
• Find 方法用于定义最后一个单元格，因为 End(xlUp) 在隐藏和过滤行时变得不可靠。
• 阵列用于阻止窒息。

守则

Option Explicit

Sub Move_Checks()
    
    ' Constants
    Const SheetName As String = "Combined"
    Const FirstRow As Long = 2
    Const LastRowCol As Variant = "A" ' e.g. 1 or "A"
    Const SourceCol As Variant = "B"
    Const TargetCol As Variant = "D"
    Const Criteria As String = "Check"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Write values from Source Column Range to Source Array.
    Dim ws As Worksheet: Set ws = wb.Worksheets(SheetName)
    Dim rng As Range
    Set rng = ws.Columns(LastRowCol).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Sub
    If rng.Row < FirstRow Then Exit Sub
    Set rng = ws.Range(ws.Cells(FirstRow, SourceCol), _
                       ws.Cells(rng.Row, SourceCol))
    Dim Source As Variant: Source = rng.Value
    
    ' Write values from Target Column Range to Target Array.
    Dim ColOff As Long: ColOff = ws.Columns(TargetCol).Column - rng.Column
    Dim Target As Variant
    Target = rng.Offset(, ColOff)
    
    ' Modify values in the Arrays.
    Dim i As Long
    For i = 1 To UBound(Source)
        If IsNumeric(Source(i, 1)) Then
            Target(i, 1) = Source(i, 1)
            Source(i, 1) = Criteria
        End If
    Next i
    
    ' Write modified values of the Arrays back to the Ranges.
    rng.Value = Source
    rng.Offset(, ColOff).Value = Target
    
    ' Inform user.
    MsgBox "Done"
  
End Sub