Question

我想做什么：

在col I的另一个日期列表中搜索col B的日期列表，如果是，则执行某些操作。

这似乎很容易做到，我已经尝试了很多使用不同的方法，但由于某种原因无法完全检测到它。

如果您想查看格式以及数据格式化方式等，请参阅Workbook。

Option Explicit
Sub RatioFinder()

'Variable Declarations
Dim wk, ws As Worksheet
Dim i, j, l, m, n, p, q As Long
Dim sdate, edate, df, ndate, ckdate, midate As Date
Dim st, ITol, STol, ETol As Variant
Dim win As Variant
Dim FRow, FRowO As Long
Dim rt As Double

'Setting Worksheet Variables
Set wk = Sheet1
Set ws = Sheet3

wk.Range("I2:Z1048576").Clear

'Finding LastRows
FRow = wk.Range("A1048576").End(xlUp).Row       'Total No. of dates
FRowO = ws.Range("A1048576").End(xlUp).Row      'For Ouput Sheet

'Total No. of Ratios
win = wk.Range("D1048576").End(xlUp).Row - 1

'Tolerance Values
ITol = wk.Range("G2").Value  'Except the start Date and End Date Match with using this Tolerance
STol = wk.Range("G3").Value  'This is for Start Date only can be negative
ETol = wk.Range("G4").Value  'This is for End Date only can be negative

'First loop is to loop through the Date Col "B" and get every combination of start and End date.
'First it takes one date as start date and Every other date as End Date

Dim ct, z As Long

n = 2
z = 2
ct = 0

For i = 2 To FRow - 1
        sdate = wk.Range("B" & i).Value            'Get Start Date

        For j = i + 1 To FRow
        edate = wk.Range("B" & j).Value            'Get End Date
        df = edate - sdate                         'Get Difference

                If df >= win Then                     'Check if enough dates are available

                    'Calculate Ratios
                    For m = 2 To (win + 1)

                        rt = wk.Range("D" & m).Value        'Ratio
                        ndate = Round(Round(df * rt) + sdate)      'NewDate According to Ratio
                        wk.Range("I" & n).Value = ndate     'Print New Date
                        wk.Range("J" & n).Value = rt        'Print Ratio
                        wk.Range("K" & n).Value = sdate     'Print Start Date
                        wk.Range("L" & n).Value = edate     'Print End date
                        wk.Range("M" & n).Value = df        'Print Difference
                        n = n + 1

                    Next m

从此处开始，代码开始检查是否找到了除开始日期和结束日期之外的所有日期。示例：在宏完成之后，您将看到col I中的所有日期都在col B中，但是它无法检测到不知道原因。

                           'This is to check whether all the dates are present in the list or not
                            For p = 3 To win    'win is 8 here
                            ckdate = wk.Range("I" & p).Value  'Get Date to Check

                                For q = 2 To FRow
                                    midate = wk.Range("B" & q).Value
                                    If ckdate >= (midate - ITol) And ckdate <= (midate + ITol) Then
                                        ct = ct + 1
                                    Else: End If
                                Next q

                            Next p

                            'Check if All the Internal Dates were found or not
                            If ct >= (win - 2) Then
                                wk.Range("O" & z) = ct
                                wk.Range("P" & z) = sdate
                                wk.Range("Q" & z) = edate
                                z = z + 1
                            Else: End If

                Else: End If
                n = 2
                ct = 0

        Next j
Next i

End Sub

还有其他方法可以做我想做的事吗？

我想做什么：

在col I的另一个日期列表中搜索col B的日期列表，如果是，则执行某些操作。

Answer 1

使用DateSerial。

Dim lngDate1 as long
Dim lngDate2 as long


lngDate1 = DateSerial(Year(dte1), Month(dte1), Day(dte1))
lngDate2 = DateSerial(Year(dte2), Month(dte2), Day(dte2))

If lngDate1 = lngDate2 then do something

Answer 2

这可能不是问题，但可能会导致问题，edate实际上是一个vba函数，因此可能想要更改该变量名称。

无法在另一个日期列表中找到日期列表 - vba

2 个答案: