程序停止工作在第二个runthrough

Question

Visual Basic问题：

Hello Friends，

我的问题非常复杂（尽管解决方案很可能很简单）：

我在Visual Basic中编写了一个小应用程序。它是一个小型时间管理系统，具有4个简单的功能（在单独的按钮上）：

＆＃34;开始工作：＆＃34;

从System获取当前日期，将其与excel表中的日期列表进行比较，将当前行设置为具有拟合日期的行，并在相应的单元格中输入当前时间。

其他功能是＆＃34;停止工作＆＃34;，＆＃34;开始休息＆＃34;并且＆＃34;停止休息＆＃34;并以同样的方式工作。

应用程序由嵌入在表单中的按钮启动并起作用 - 到目前为止一切顺利。但是，如果我启动VBA自己的调试器，然后再次启动程序，它就会失败，因为从日期列表中嗅出正确日期的函数无法找到正确的值。在这一点上，我几乎没有想法（特别是因为这是我的第一个VBA项目），所以如果有人能给我指向正确的方向，我真的很高兴。

这里是获取日期的函数：

Function get_date(time As Date)             'findet das aktuelle Datum in Spalte 2 (Datum)

    Dim findDate As Range
    On Error Resume Next
    Set findDate = Columns(2).Find(Date)
    Err.Clear
    On Error GoTo 0
    If findDate Is Nothing Then
    MsgBox "Current Date not on Active Form!"
    Else: MsgBox "Current Date is " & Date
    MsgBox findDate
    Exit Function
    End If


End Function

并将该行设置为具有当前日期的行

Function get_row(time As Date)

Dim rngSearch As Range, rngFound As Range
Set rngSearch = Range("B5:B18")
Set rngFound = rngSearch.Find(What:=Date, LookIn:=xlValues, LookAt:=xlPart)
If rngFound Is Nothing Then
MsgBox "Aktuelles Datum nicht gefunden - Terminplan erweitern"
Else
get_row = rngFound.row
End If

End Function

正如我所提到的，这些功能在表单的第一次启动时工作得非常好，但如果我再次调试并启动Makro则无法找到（并因此返回）一个值。

该程序还在计时器上实时运行时钟 - 也许这是一个因素？说实话，我完全失败了。

对代码的任何批评以及我如何处理某些问题也非常受欢迎 - 这是我有史以来的第一个VBA应用程序。

更新

根据要求，这里是我认为是搜索范围的屏幕截图：

我使用1904年的日期系统，但改回1900并没有任何效果。

如果有人有兴趣，我将整个项目上传到我的github Stechuhr.xlsm

相关文件是＆＃34; Stechuhr.xlsm＆＃34;

非常感谢任何进一步的帮助。

编辑：澄清 - 一旦暂停然后恢复，程序就会停止工作。我怀疑计时器功能在某种程度上对此负责 - 将进行进一步的测试。

更新2：

由于我无法解决这个问题，我按照建议简化了我的问题：

Option Explicit

Public Function FindDateRowInColB(TargetDate As Date, TargetSheet As Worksheet) As Long

    Dim FoundRange As Range
    Set FoundRange = TargetSheet.Columns(2).Find(What:=TargetDate, LookIn:=xlValues, LookAt:=xlPart)
    If FoundRange Is Nothing Then
        FindDateRowInColB = 0
    Else
        FindDateRowInColB = FoundRange.Row
    End If

End Function

'Test Button 1

Private Sub Test_button_Click()

    Dim TestTime As Date
    Dim TestSheet As Worksheet
    Dim TestRow As Long
    Dim pdat_Datum As Date

    pdat_Datum = Date

    'set references
    Set TestSheet = ThisWorkbook.Worksheets("Tabelle1")

    'this is our test assertion
    TestRow = FindDateRowInColB(pdat_Datum, TestSheet)

    'short if statement to display a message based on test results
    MsgBox ("TestRow =" & TestRow)

End Sub

' Test Button 2

Private Sub TestButton_2_Click()

    Dim active_row As Integer
    Dim pdat_aktuellesDatum As Date
    Dim TestSheet As Worksheet

   pdat_aktuellesDatum = Date

   Set TestSheet = ThisWorkbook.Worksheets("Tabelle1")

     'set references
    Set TestSheet = ThisWorkbook.Worksheets("Tabelle1")

    active_row = FindDateRowInColB(pdat_aktuellesDatum, TestSheet)

    MsgBox ("Die passende Reihe zum heutigen Datum ist " & active_row)
End Sub

有代码。它只是一个功能和2个按钮来测试它。但是，它与我的原始代码有相同的问题 - 在第一次启动时工作正常，但如果我暂停程序并再次启动它，FindDateRowInColB总是返回null值。我想可能存在一些内存管理问题。

如果有人有进一步的意见，我们将不胜感激。

Answer 1

您可以为您的函数创建一个轻量级测试环境，以确保它们返回您在某些条件下所期望的内容。下面是一个示例函数，用于在B列中查找日期匹配以及两个测试：

Option Explicit
Public Function FindDateRowInColB(TargetDate As Date, TargetSheet As Worksheet) As Long
    Dim FoundRange As Range
    Set FoundRange = TargetSheet.Columns(2).Find(What:=TargetDate, LookIn:=xlValues, LookAt:=xlPart)
    If FoundRange Is Nothing Then
        FindDateRowInColB = 0
    Else
        FindDateRowInColB = FoundRange.Row
    End If
End Function

Sub TestFindDateRowFunctionSuccess()

Dim TestTime As Date
Dim TestSheet As Worksheet
Dim TestRow As Long

'set references
Set TestSheet = ThisWorkbook.Worksheets("Sheet1")
TestTime = "4/22/2014"

'this is our test assertion
TestRow = FindDateRowInColB(TestTime, TestSheet)

'short if statement to display a message based on test results
If TestRow = 3 Then
    MsgBox ("Test passed! Identified 4/22/2014 in row 3")
Else
    MsgBox ("Test failed! Did not identify 4/22/2014 in row 3")
End If

End Sub

Sub TestFindDateRowFunctionFailure()

Dim TestTime As Date
Dim TestSheet As Worksheet
Dim TestRow As Long

'set references
Set TestSheet = ThisWorkbook.Worksheets("Sheet1")
TestTime = "4/1/2014"

'this is our test assertion
TestRow = FindDateRowInColB(TestTime, TestSheet)

'short if statement to display a message based on test results
If TestRow = 0 Then
    MsgBox ("Test passed! Date 4/1/2014 was not found so 0 was returned")
Else
    MsgBox ("Test failed! Date 4/1/2014 was identified somewhere")
End If

End Sub