如果未使用 VBA 找到推荐日期，如何查找下一个可用日期

Question

我需要帮助。我有 Sheet 1 和 Sheet2。在 Sheet1/2 中，我在 B 列中有日期，两个 sheet 日期都不相同，但是当我推荐 Select 打印日期时，我希望 VBA 到 select 最近的日期，如果找不到我的约会对象。例如：- 如果我要求 VBA 从日期 12-Aug-17 开始打印，我可以在 sheet1 中编辑 select 但在 Sheet 2 中没有 8 月 12 日所以它必须 select 13 或 11 并打印。在我的代码中，如果它在同一日期，它将打印两个 sheet。但是，如果失败，则会显示错误。

代码

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

我认为您的代码有 2 个问题：

j2 & j3 是变体（不是整数，我想你想要的）
您的代码没有做任何事情来查找 "the closest" 日期 -- 您有一个 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

如果未使用 VBA 找到推荐日期，如何查找下一个可用日期

how to find next Available date if it didn't find comended date using VBA

excel

vba

date

spreadsheet