选择相差较大或等于1的日期

时间:2020-06-24 17:49:01

标签: excel vba date-range

大家好,我在excel表中有下一个数据

datasheet

我的问题是我该如何仅使用差异主要或等于1的日期来过滤此信息,总之,我想从Visual Basic中将最后一张表分类为: enter image description here

如果有人可以帮助我编写解决此问题的代码,我将非常感谢您的帮助。

1 个答案:

答案 0 :(得分:0)

好吧,我将使用next分享我在vba中解决此问题的方法:

''dimension of variables
dim ws as worksheet

set ws=thisworkbook.worksheets(sheet1)

now i got my matrix
set arrdata = ws.range("A1").CurrentRegion

fechainicio = CDate(Format(arrdata(1)(0), "dd/mm/yy")): numfechas = UBound(arrdata, 1)
fechafin = CDate(Format(arrdata(numfechas)(0), "dd/mm/yy"))

Dim datofecharr() As Variant
m = 1
For i = fechainicio To fechafin
    k = 1
    Dim datofecha() As Variant
    For j = 1 To numfechas
    If CDate(Format(arrdata(j)(0), "dd/mm/yy")) = i Then
     ReDim Preserve datofecha(1 To k)
     datofecha(k) = arrdata(j)(0)
     k = k + 1
    End If
    Next j
ReDim Preserve datofecharr(1 To m)
    datofecharr(m) = datofecha
    m = m + 1
Next i

lendatofecharr = UBound(datofecharr, 1)
Dim fechadiariarr() As Variant

ReDim Preserve fechadiariarr(1 To 1)
''seleccionamos la fecha minima de registro
fechadiariarr(1) = WorksheetFunction.min(datofecharr(1))
m = 2
''solo tomando los datos cuya diferencia horaria sea mayor o igual a 1 día
For i = 2 To lendatofecharr
    For k = 1 To UBound(datofecharr(i))
        If datofecharr(i)(k) - fechadiariarr(m - 1) >= 1 Then
         ReDim Preserve fechadiariarr(1 To m)
         fechadiariarr(m) = datofecharr(i)(k)
         m = m + 1
        Exit For
        
     End If
    Next k
 
Next i

Dim datosdiariosarr() As Variant
For i = 1 To UBound(fechadiariarr, 1)
    For j = 1 To UBound(arrdata, 1)
    If fechadiariarr(i) = arrdata(j)(0) Then
    ReDim Preserve datosdiariosarr(1 To i)
    datosdiariosarr(i) = arrdata(j)
    Exit For
    
    End If
    
    Next j
Next i