程序停止2日runthrough工作

Question

的Visual Basic問題：

朋友你好，

我的問題是相當複雜的（儘管該解決方案是最有可能的一個簡單的一個）：

我寫了一個在Visual Basic中的小應用程序。這是一個帶有4個簡單的功能（在單獨的按鈕），一個小的時間管理系統：

「開始工作：」

獲取來自系統的當前日期，在一個Excel表格把它比作日期的列表，設置將當前行放入裝配日期的行中，並在適當的單元格中輸入當前時間。

其他功能是「停止工作」，「開始休息」和「停止休息」，工作方式幾乎相同。

該應用程序由一個嵌入在表單中的按鈕啓動，並且工作 - 迄今爲止非常好。但是，如果我啓動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

相關的文件是「Stechuhr.xlsm」

任何進一步的幫助，將不勝感激。

編輯：澄清 - 程序停止工作，一旦暫停，然後恢復。我懷疑計時器功能對此負有責任 - 將做進一步的測試。

更新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