如果没有使用VBA找到合作日期,如何找到下一个可用日期

时间:2017-07-29 07:28:41

标签: excel vba excel-vba date spreadsheet

我需要帮助。我有Sheet 1和Sheet2。在Sheet1 / 2中,我在B栏中有日期,两个工作日期不相同,但当我推荐选择打印日期时,我希望VBA选择最近的日期,如果它没有找到我的日期。例如: - 如果我要求VBA从日期12-Aug-17打印我可以在sheet1中选择,但在Sheet 2中没有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

请参阅我的代码上方。

1 个答案:

答案 0 :(得分:1)

我认为您的代码有两个问题:

  1. j2& j3是变体(不是整数,我认为你想要的)
  2. 您的代码没有做任何事情来找到“最接近的”日期 - 您有一个closest日期变量,在任何地方都没有使用
  3. 由于(1),如果未找到与日期的完全匹配,则不会定义j2j3,因此sh3.Range("A1", "K" & j3).PrintPreview之类的行会崩溃。请注意我的代码j2& j3是整数。相比之下,在您的代码中,ij2j3sh2EndCell的类型未指定,因此默认情况下为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