次の検索方法VBAを使用して日付が見つからなかった場合は、利用可能な日付

Question

私はここで助けが必要です。私はシート1とシート2を持っています。 Sheet1/2ではB列に日付があり、両方の日付が同じではありませんが、印刷日付を選択すると、VBAは日付を見つけることができない場合に最も近い日付を選択します。例： - VBAに12月8日の日付から印刷するように頼んだら、sheet1で選択することができますが、シート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 

私のコード上を参照してください。

Answer 1

私はあなたのコードと2つの問題があると思う：最も近い「（私はあなたが欲しいと思うように、ではない整数）

1. j2 & j3が変異体である
2. はあなたのコードを見つけるために何もしません「日付 - あなたはどこにでもあるための

を使用していないclosest日付変数を持っている（1）、日付の正確な一致が見つからない場合、またはj2j3は定義されないので、sh3.Range("A1", "K" & j3).PrintPreviewのような行はクラッシュします。私のコードでどのようにしてくださいj2 & j3は整数になります。対照的に、あなたのコードでは、タイプi,j2,j3,は指定されていないので、デフォルトでバリアントです。

解決するには、次のコードでそれぞれの場合に最も近い日付を見つけます。 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