如果输入的日期不存在,则连续跳转到最近的日期

时间:2013-05-09 04:15:12

标签: vba excel-vba excel

我的代码是查找用户在Excel工作表中输入的开始日期和结束日期,以便用户可以找到输入日期的产品转换次数。如果用户输入行中存在的开始和结束日期,它可以正常工作。问题是当用户输入行中不存在的开始和结束日期时,它将给出产品转换次数= 0。例如,我的数据包括2013年1月2日至2013年1月28日期间的10个产品转换日期。但是当用户输入开始日期= 2013年1月1日,结束日期= 2013年1月29日(行中不存在的日期)时,转换次数为0.我想要做的是如果日期不是如果存在于行中,程序将自动跳转到最近的日期。 这是我的代码:

Dim rowFound As Variant
Dim startDate As String, endDate As String, startDateRow As Long
Dim endDateRow As Long, product As String, convNo As Long

Set ws2 = ActiveWorkbook.Sheets("Products Conversion")
Set wsMain = ActiveWorkbook.Sheets("Main Menu")

ws2.Activate
lastrow2 = ws2.Range(Range("A1"), Range("A65535").End(xlUp)).count ' find lastrow
wsMain.Activate

startDate = Me.txtStartDate.Value

endDate = Me.txtEndDate.Value

On Error Resume Next
If txtStartDate <> "" Or txtEndDate <> "" Then

For i = 3 To lastrow2

    If CDate(startDate) = ws2.Cells(i, 1).Value Then
        startDateRow = i   ' row where start date is
        Exit For
    End If

Next


For j = lastrow2 To 3 Step -1

    If CDate(endDate) = ws2.Cells(j, 1).Value Then
        endDateRow = j      ' row where end date is
        Exit For
    End If

Next

For k = startDateRow To endDateRow - 1

    product = ws2.Cells(k, 6).Value

    If product <> ws2.Cells(k + 1, 6).Value Then
        convNo = convNo + 1 'number of conversion
    End If

Next

Else
MsgBox "Please enter both date!", vbOKOnly + vbCritical
End If

Me.txtConvNo.Value = convNo

1 个答案:

答案 0 :(得分:1)

最后我可以想象它。只需添加一些循环

Dim rowFound As Variant
Dim startDate As String, endDate As String, startDateRow As Long
Dim endDateRow As Long, product As String, convNo As Long

Set ws2 = ActiveWorkbook.Sheets("Products Conversion")
Set wsMain = ActiveWorkbook.Sheets("Main Menu")

ws2.Activate
lastrow2 = ws2.Range(Range("A1"), Range("A65535").End(xlUp)).count ' find lastrow
wsMain.Activate

startDate = Me.txtStartDate.Value

endDate = Me.txtEndDate.Value

On Error Resume Next
If txtStartDate <> "" Or txtEndDate <> "" Then

resume1:
For i = 3 To lastrow2

    If CDate(startDate) = ws2.Cells(i, 1).Value Then
        startDateRow = i ' row where start date is
        Exit For
    End If

Next

If startDateRow = 0 Then 'date entered not found in the row
    startDate = CDate(startDate) + 1
    GoTo resume1
End If

resume2:
For j = lastrow2 To 3 Step -1

    If CDate(endDate) = ws2.Cells(j, 1).Value Then
        endDateRow = j ' row where end date is
        Exit For
    End If


Next 

If endDateRow = 0 Then 'date entered not found in the row
    endDate = CDate(endDate) - 1
    GoTo resume2
End If

Next

For k = startDateRow To endDateRow - 1

product = ws2.Cells(k, 6).Value

If product <> ws2.Cells(k + 1, 6).Value Then
    convNo = convNo + 1 'number of conversion
End If

Next

Else
MsgBox "Please enter both date!", vbOKOnly + vbCritical
End If

Me.txtConvNo.Value = convNo
vba excel-vba