VBA - Ensemble de la Gamme Entre les Deux Dates à l'Aide de la Fonction Recherche

Commençons par cela et voir ce qui doit être ajusté.
Ce code va chercher une date (en fonction de l'entrée) et trouver la position de cette date dans une colonne. Même avec les "EndDate" et puis crée une gamme sur cette colonne entre les 2 positions.

Sub ARange()
Dim Sh As Worksheet: Set Sh = Sheets("Sheet1")
Dim i, j As Integer

LookupColumn = "A" 'Define the LookupColum /If you find using column index to be simpler then you need to switch the search from (range) to (cells)
StartDate_Value = Sh.Range("B2").Value 'Use whatever you need to define the input values
EndDate_Value = Sh.Range("C2").Value 'Use whatever you need to define the input values

For i = 1 To 30000
    If Sh.Range(LookupColumn & i).Value = EndDate_Value Then EndDate_Row = i
Next i

For j = EndDate_Row To 1 Step -1
    If Sh.Range(LookupColumn & j).Value = StartDate_Value Then StartDate_Row = j
Next j

Dim MyDateRange As Range: Set MyDateRange = Sh.Range(LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row)
MsgBox "MyDateRange = " & LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row
End Sub

Une autre approche implique la recherche de la date de fin de bas en haut (comme dans Excel les valeurs de colonne) et pour la date de début de haut en bas. comme ceci:

For i = 30000 to 1 step -1
For j = 1 To 30000

Et le 3ème (le charme):pour la date de fin du haut vers le bas et de la date de début de haut en bas. comme ceci:

For i = 1 to 30000
For j = 1 To 30000

Et le 4ème (Le seul):

For i = 1 to 30000
For j = 30000 to 1 Step -1

Sur mon ordinateur portable à la maison de la recherche sur les 30.000 cellules est instantanée (moins de 1s).
Essayez-le et après les réactions que nous pouvons affiner.

De l'Autre côté, je pourrais lire votre question de recherche Pour sélectionner toutes les valeurs ne entre le haut et le bas de la position, mais toutes les cellules avec des valeurs de dates entre les 2 valeurs d'entrée neverminind l'arrangement des valeurs au sein de la liste (colonne de cellules). c'est à dire Si StartDate = 1.Janv.2013 et EndDate = 3.Janv.2013. Le code doit ramasser les 1,2 et 3 de l'30.000 liste neverminind la position de ces 3 dates (qui en fait peut-être trouvé des milliers de fois). Si Cela est vrai, la solution peut être plus simple que la précédente.

Je n'aime pas le concept de cette date, recherche pour un couple de raisons..

• Il fait l'hypothèse que les dates seront toujours dans le but
• Il fait l'hypothèse que les deux dates existe pas dans la liste

Alors que ceux-ci peuvent être valide les hypothèses dans ce cas, je suis sûr qu'il peut y avoir des cas où cela peut ne pas être le cas...

Je ne sais pas la meilleure façon de faire cela, mais une alternative à considérer est l'aide de l'auto-filtre

Quelque chose comme:

 Sub FindDateRange()
Dim sht As Worksheet
Dim column As Long
Set sht = Sheet1
Dim rng As Range, inclusiveRange As Range
Dim startDate As Long, endDate As Long
column = 2
On Error GoTo Err
startDate = DateValue("02/10/2012")
endDate = DateValue("05/10/2012")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
sht.Cells(1, column).AutoFilter Field:=column, Criteria1:=">=" & startDate, Operator:=xlAnd _
, Criteria2:="<=" & endDate
Set rng = sht.Range(sht.Cells(2, column), sht.Cells(sht.Cells(sht.Rows.Count, column).End(xlUp).Row, column)).SpecialCells(xlCellTypeVisible)
sht.AutoFilterMode = False
If rng.Address = sht.Cells(1, column).Address Then
MsgBox Format(startDate, "dd-mmm-yyyy") & " - " & Format(endDate, "dd-mmm-yyyy") _
& vbCrLf & vbCrLf & "No instances of the date range exist"
Else
Set inclusiveRange = sht.Range(rng.Cells(1, 1), rng.Cells(rng.Count, 1))
MsgBox Format(startDate, "dd-mmm-yyyy") & " - " & Format(endDate, "dd-mmm-yyyy") _
& vbCrLf & vbCrLf & "the range is " & rng.Address & vbCrLf & vbCrLf & _
"inclusive range is " & inclusiveRange.Address
End If
continue:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
Err:
MsgBox Err.Description
GoTo continue
End Sub