VBA ile bir tarih ya da sonraki tarihleri ​​nasıl bulabilirim?

Question

Bir çalışma sayfasında ilerleyen haftadaki tüm girdileri bulmak için bir makro yazıyorum ve en erken tarihle eşleşen ilk satırı seçin. Makroyu ilk tarihi (hafta geri) bulmayı başarabilirim, ancak ilk tarihin eşleşme olmaması durumunda sonraki tarihleri ​​nasıl bulabilirim?

E.G. Bugünkü tarih: 28Mar16. Makro 7 gün geriye bakacak (21Mar16). 21Mar16 için giriş yok ise, 22Mar16 tarihli ilk girişi bulun. Bu tarihte tarih yoksa, 23Mar16, vs.

Bu mümkün mü? İşte

bugüne kadar kodudur:

Private Sub CommandButton1_Click() 
Dim strFilename As String 
Dim rngRange As Range 
Dim strfind As String 

Set strfind = Worksheets("Report").Range("J1") 
Set rngRange = Worksheets("Report").Range("B:B") 

If opt1.Value = True Then 
Cells.Find(what:=strfind, after:=ActiveCell, LookIn:=xlValues, Lookat:=xlPart, _ 
    searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False, searchformat:=False).Activate 
If opt2.Value = True Then 
Cells.Find(what:=strfind, after:=ActiveCell, LookIn:=xlValues, Lookat:=xlPart, _ 
    searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False, searchformat:=False).Activate 



End If 
'Range("A1:H100").Select 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
"C:\Desktop\Obs Diary Report week starting " & strFilename & ".pdf", Quality:= _ 
     xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ 
     OpenAfterPublish:=True 
End Sub 

sayesinde

Hıristiyan

Answer 1

Verilerinizde çalışmalarınızı ne söyleyeceğim ama tüm yapmanız gereken Find aracılığıyla döngü zor Bugünün tarihine ya da bir şey bulana kadar, her seferinde bir arama yapmak için tarihi arttırmak.

Option Explicit 
Sub OneWeekAgo() 
    Dim dtEarliest As Date 
    Dim WS As Worksheet 
    Dim R As Range 

Set WS = ActiveSheet 
dtEarliest = Date - 7 

With WS.Cells 
    Do Until Not R Is Nothing 
     Set R = .Find(dtEarliest) 
      dtEarliest = dtEarliest + 1 
      If dtEarliest > Date Then 
       Debug.Print "No Dates in Last Week" 
       Exit Sub 
      End If 
    Loop 
End With 

If Not R Is Nothing Then 
    Debug.Print R.Address, R.Text 
End If 

End Sub