如何找到下一個可用的日期，如果它沒有找到使用VBA comended日期

Question

我需要幫助在這裏。我有Sheet 1和Sheet 2。並在Sheet1/2中有B列日期和兩個工作表日期不相同，但是當我推薦選擇日期打印我想要VBA選擇最近的日期，如果它找不到我的日期。例如： - 如果我要求VBA從日期12-Aug-17打印，我可以在Sheet1中選擇，但在Sheet2中沒有8月12日，所以它必須選擇13日或11日並打印。在我的編碼中，如果它在相同的日期，它將打印兩張表。但如果失敗了，它會顯示錯誤。

代碼

Sub CreatePDF() 
Dim Sh As Worksheet 
Set sh2 = Sheets("Sheet2") 
Set sh3 = Sheets("Sheet3") 
Dim i, j2, j3, sh2EndCell, sh3EndCell As Integer 
Dim closest As Date 
Dim W1Enddate As Date 

W1Enddate = Application.InputBox("Enter the End Date") 
sh2EndCell = sh2.Range("b" & Rows.Count).End(xlUp).Row 
sh3EndCell = sh3.Range("b" & Rows.Count).End(xlUp).Row 
For i = 2 To sh2EndCell 
    If sh2.Range("b" & i).Value = W1Enddate Then 
     j2 = i 
     Exit For 
    End If 
Next i 

For i = 2 To sh3EndCell 
    If sh3.Range("b" & i).Value = W1Enddate Then 
     j3 = i 


     Exit For 
    End If 
Next i 

sh2.Range("A1", "K" & j2).PrintPreview 
sh3.Range("A1", "K" & j3).PrintPreview 

Application.ScreenUpdating = False 

sh2.PageSetup.PrintArea = ("A1:K" & j2) 
sh3.PageSetup.PrintArea = ("A1:K" & j3) 
Sheets(Array("sheet2", "sheet3")).Select 

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ 
Filename:="", _ 
OpenAfterPublish:=True 
Application.ScreenUpdating = True 

End Sub 

請參見上面我的代碼。

Answer 1

我覺得有兩個問題與您的代碼：

1. j2 & j3變異體（不是整數，因爲我想你想）
2. 您的代碼不會做任何事情來找到「最接近「日期 - 你有沒有在任何地方使用

由於一個closest日期變量（1），如果日期完全匹配沒有找到，j2或j3將不會被定義，因此像sh3.Range("A1", "K" & j3).PrintPreview這樣的行會崩潰。請注意如何在我的代碼j2 & j3是整數。相比之下，在您的代碼中，i，j2，j3，sh2EndCell的類型未指定，因此默認情況下爲Variant）。

要解決（2），下面的代碼找到每種情況下最接近的日期。 min作爲一個大數字開始，並且被替換爲diff，每次發現日期之間的較小差異。請注意，我的代碼中不再有Exit For，因爲它循環遍歷所有日期以確保它找到了最近的日期。希望有所幫助。

Option Explicit 
Sub CreatePDF() 
Dim Sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet 
Set sh2 = Sheets("Sheet2") 
Set sh3 = Sheets("Sheet3") 
Dim i As Integer, j2 As Integer, j3 As Integer, sh2EndCell As Integer, sh3EndCell As Integer 
Dim closest As Date, diff As Long, min As Long 
Dim W1Enddate As Date 

W1Enddate = Application.InputBox("Enter the End Date") 
sh2EndCell = sh2.Range("b" & Rows.Count).End(xlUp).Row 
sh3EndCell = sh3.Range("b" & Rows.Count).End(xlUp).Row 
min = 100000# 
For i = 2 To sh2EndCell 
    diff = Abs(W1Enddate - sh2.Range("b" & i).Value) 
    If diff < min Then 
    min = diff 
    j2 = i 
    End If 
Next i 
min = 100000# 
For i = 2 To sh3EndCell 
    diff = Abs(W1Enddate - sh3.Range("b" & i).Value) 
    If diff < min Then 
    min = diff 
    j3 = i 
    End If 
Next i 

sh2.Range("A1", "K" & j2).PrintPreview 
sh3.Range("A1", "K" & j3).PrintPreview 

Application.ScreenUpdating = False 

sh2.PageSetup.PrintArea = ("A1:K" & j2) 
sh3.PageSetup.PrintArea = ("A1:K" & j3) 
Sheets(Array("sheet2", "sheet3")).Select 

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ 
Filename:="", _ 
OpenAfterPublish:=True 
Application.ScreenUpdating = True 

End Sub