如何找到下一个可用的日期,如果它没有找到使用VBA comended日期
问题描述:
我需要帮助在这里。我有Sheet 1和Sheet 2。并在Sheet1/2中有B列日期和两个工作表日期不相同,但是当我推荐选择日期打印我想要VBA选择最近的日期,如果它找不到我的日期。例如: - 如果我要求VBA从日期12-Aug-17打印,我可以在Sheet1中选择,但在Sheet2中没有8月12日,所以它必须选择13日或11日并打印。在我的编码中,如果它在相同的日期,它将打印两张表。但如果失败了,它会显示错误。如何找到下一个可用的日期,如果它没有找到使用VBA comended日期
代码
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
请参见上面我的代码。
答
我觉得有两个问题与您的代码:
-
j2
&j3
变异体(不是整数,因为我想你想) - 您的代码不会做任何事情来找到“最接近“日期 - 你有没有在任何地方使用
由于一个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
你想让代码做到这一点有两个日期,两个相同的距离。例如,你选择了第11名,但是,第11名和第12名不在表中。你要哪个? –