如何在此VBA代码中找到重复的日期?

时间:2017-07-04 09:29:17

标签: excel vba

如何在此代码中的数组DataInicio中找到重复的日期?我需要找到所有重复的日期和次数。对我来说,知道它只是重复是没有用的。

谢谢!

我一直想弄明白,但没有任何工作。

Sub EscalaDinâmicaHTA()

Dim NumHelis As Integer
Dim DataInicio(1 To 15) As Date
Dim DataFim As Date
Dim ContData As Double
Dim LinHeliInicial As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim a As Integer
Dim b As Integer


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

a = 1

Do While LinHeliInicial <= LinTotal

i = 2
j = 3
k = 4

Do While i <= 14 And j <= 15 And k <= 16      '26,27,28

DataInicio(a) = Worksheets(1).Cells(LinHeliInicial, i).Value
ContData = DateValue(DataInicio(a))
ContData = Val(ContData)

DataFim = Worksheets(1).Cells(LinHeliInicial, j).Value
DataFim = DateValue(DataFim)

Duracao = DataFim - DateValue(DataInicio(a))
Worksheets(1).Cells(LinHeliInicial, k).Value = Duracao + 1
Duracao = ContData + Duracao
Duracao = Val(Duracao)

ContData = ContData - 43072         '43072 é a descontar as colunas A,B,C,D,etc até ao começo do calendário
Duracao = Duracao - 43072


Do While ContData <= Duracao
Cells(LinHeliInicial, ContData).Interior.ColorIndex = 4
ContData = ContData + 1
Loop

k = k + 3
j = j + 3
i = i + 3

a = a + 1

Loop

LinHeliInicial = LinHeliInicial + 1

Loop


End Sub

1 个答案:

答案 0 :(得分:0)

这将输出数组中的重复项数。请注意,如果多次出现,它将多次输出相同的元素。这可以通过跟踪另一个数组中的已检查元素来轻松修复,如果之前未检查过,则只检查它们(即创建一个包含唯一条目的数组进行检查)。

Dim counter As Integer
Dim varElement1 As Variant
Dim varElement2 As Variant

'get element within array
For Each varElement1 In array
    'reset counter
    counter = 0
    For Each varElement2 In array
        'compare varElement1 with each element of array
        If varElement2 = varElement1 Then
            'increase counter if match was found (1 will alway be found -> the element itself)
            counter = counter + 1
        End If
    Next varElement2
    'output number if more than 1 (more than itself) was found
    If counter > 1 Then
        Debug.Print varElement1 & " occured " & counter " times"
    End If
Next varElement1

编辑:简化代码,添加评论