Question

我正在尝试运行此代码，但它给了我一个错误。这两个代码分别运行良好。但是，当我将两个代码组合在一起时，它们运行不正常以产生所需的结果。任何人都可以帮助我吗？

Sub Macro1()
'
' Macro1 Macro
'

'
    Application.ScreenUpdating = False
    Range("X12").Select
    Selection.Copy
    Range("W12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    If Bt 1.Range("Z3") = 0 Then Exit Sub
        Bt1.Range("Z3").Value = Bt 1.Range("z3").Value - TimeValue("00:00:01")

    If Bt 1.Range("z3").Value <= TimeValue("00:00:10") Then
        Bt 1.Sheepes("TextBox 1").Fill.ForceColor.RGB = RGB(255, 0, 0)

    Else
        Bt 1.Shapes("TextBox1").Fill.ForceColor.RGB = RGB(255, 255, 255)

    End If
       Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End Sub

Answer 1

除了评论中提到的不正确的代码行（特别感谢@Mrig），您的代码缺少一些检查来验证代码是否正常工作。所以，这里是适当调整的代码：

Option Explicit

Sub Macro1()

Dim shp As Shape
Dim ws As Worksheet
Dim bolFound As Boolean

Application.ScreenUpdating = False

'Checking if there is a sheet 'Bt 1'
bolFound = False
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Bt 1" Then bolFound = True
Next ws
If bolFound = False Then
    MsgBox "Required sheet 'Bt 1' not found." & Chr(10) & "Aborting..."
    Exit Sub
End If

With ThisWorkbook.Worksheets("Bt 1")
    'Copying the value from X12 to W12
    .Range("W12").Value2 = .Range("X12").Value2
    'Checking Z3 before proceeding
    If .Range("Z3") = 0 Then
        MsgBox "Z3 is 0." & Chr(10) & _
            "Aborting..."
        Exit Sub
    End If
    If Not IsNumeric(.Range("Z3").Value) Then
        MsgBox "Z3 on the sheet 'Bt 1' is not a date / time." & Chr(10) & _
            "Therefore a second cannot be subtracted from Z3." & Chr(10) & _
            "Aborting..."
        Exit Sub
    End If
    .Range("Z3").Value = .Range("Z3").Value - TimeValue("00:00:01")
    'Checking if there is a 'TextBox 1'
    bolFound = False
    For Each shp In .Shapes
        If shp.Name = "TextBox 1" Then bolFound = True
    Next shp
    If bolFound = False Then
        MsgBox "Required shape 'TextBox 1' not found." & Chr(10) & "Aborting..."
        Exit Sub
    End If
    If .Range("Z3").Value <= TimeValue("00:00:10") Then
        .Shapes("TextBox 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
    Else
        .Shapes("TextBox 1").Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
End With

Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
Application.ScreenUpdating = True

End Sub

即使代码没有按预期运行，您也应该获得足够的反馈以进行必要的更正（以便运行代码）。

如果您有任何其他问题，请与我们联系。

VBA代码+计时器

1 个答案: