VBA CountIf限制在两个日期之间

时间:2014-01-07 23:04:17

标签: excel vba excel-vba range countif

我正在尝试执行COUNTIF但是在定义范围时,要使用在前一个“查找”语句中找到的行值。通过显示我的代码可能更容易解释:

Public Sub Run_Count_Click()

'// Set Ranges
Dim Cr_1, CR1_range, _
Cr_2, CR2_range, _
Cr_3, CR3_range, _
Cr_4, CR4_range, _
Cr_5, CR5_range _
As Range

'// Set Integers
Dim CR1, V1, CR1_Result, _
CR2, V2, CR2_Result, _
CR3, V3, CR3_Result, _
CR4, V4, CR4_Result, _
CR5, V5, CR5_Result, _
total_result, _
total_result2, _
total_result3, _
total_result4, _
total_result5 _
As Integer

'Set Strings
Dim V_1, V_2, V_3, V_4, V_5 As String

Dim ws As Worksheet

Set ws = Worksheets("database")

Dim Date_Start, Date_End As Long

Date_Start = ws.Cells.Find(What:=Me.R_Start.Value, SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row

Date_End = ws.Cells.Find(What:=Me.R_End.Value, SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row

'// Get Criteria From Form And Search Database Headers
Set Cr_1 = ws.Cells.Find(What:=Me.Count_Criteria_1.Value, After:=ws.Cells(1, 1), MatchCase:=False)

If Not Cr_1 Is Nothing Then

CR1 = Cr_1.Column '//Set CR1 as the Column in which the Criteria Header was found

Else
    MsgBox "Criteria 1 Has Not Been Found In The Database. Report Has Failed To Generate"
    Exit Sub
End If

'// Get Variable Value From Form And Set Shortcode
V_1 = Me.Criteria_1_Variable.Value

Set CR1_range = ws.Range(ws.Cells(Date_Start, CR1), ws.Cells(Date_End, CR1))
CR1_Result = Application.CountIf(CR1_range, V_1)

If Me.Count_Criteria_2 = "Any" Then

Me.Count_Result.visible = True

Me.Count_Result.Value = "Based On Your Search Criteria Of:" & vbNewLine & _
"How many occurences of [" & Me.Criteria_1_Variable.Value & "] in the category [" & Me.Count_Criteria_1.Value & _
"] have occured between the dates..." & vbNewLine & vbNewLine & "The Results Are: " & CR1_Result

Exit Sub

Else 'More stuff after this that is not relevant

我收到错误消息,说下面的行需要设置一个对象:

Date_Start = ws.Cells.Find(What:=Me.R_Start.Value, SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row

    Date_End = ws.Cells.Find(What:=Me.R_End.Value, SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row

为什么?

2 个答案:

答案 0 :(得分:1)

我不知道这是否与您的问题有关,但我认为您错误地声明了您的变量。在您的设置范围段中,我假设您希望将所有这些变量设置为类型范围,但仅将CR5_Range声明为范围;其他人都被宣布为变种。虽然可以在一行上放置多个声明,但每个变量都需要定义为Type,如果省略Type,则默认为Variant Type。这可能会导致一些有用的错误消息被省略。您的其他声明段也存在同样的问题。

问题很可能是Find方法没有找到任何东西。这会产生错误。 “查找”的日期有时很棘手。您可以检查结果(没有行)是否为空。例如:debug.print .find(.....)是空的如果返回TRUE,则查找失败。

答案 1 :(得分:0)

好的,感谢您的所有投入,我设法最终解决了这个问题:

Public Sub Run_Count_Click()

'// Set Ranges
Dim Cr_1, CR1_range, _
Cr_2, CR2_range, _
Cr_3, CR3_range, _
Cr_4, CR4_range, _
Cr_5, CR5_range _
As Range

'// Set Integers
Dim CR1, V1, CR1_Result, _
CR2, V2, CR2_Result, _
CR3, V3, CR3_Result, _
CR4, V4, CR4_Result, _
CR5, V5, CR5_Result, _
total_result, _
total_result2, _
total_result3, _
total_result4, _
total_result5 _
As Integer

'Set Strings
Dim V_1, V_2, V_3, V_4, V_5 As String

Dim ws As Worksheet

Set ws = Worksheets("database")

Sheets("Settings").Range("Start_Date").Value = Format(Me.R_Start.Value, "mm/dd/yyyy")
Sheets("Settings").Range("End_Date").Value = Format(Me.R_End.Value, "mm/dd/yyyy")

'Collect Start & End Dates
Dim dStartDate As Long
Dim dEndDate As Long
dStartDate = Sheets("Settings").Range("Start_Date").Value
dEndDate = Sheets("Settings").Range("End_Date").Value

ws.Activate

'On Error GoTo error_Sdate:
Dim RowNum As Variant
    RowNum = Application.WorksheetFunction.Match(dStartDate, Range("B1:B60000"), 0)
     MsgBox "Found " & Format(dStartDate, "dd/mm/yyyy") & " at row : " & RowNum

'On Error GoTo error_Edate:
Dim RowNumEnd As Variant
    RowNumEnd = Application.WorksheetFunction.Match(dEndDate, Range("B1:B60000"), 1)
     MsgBox "Found " & Format(dEndDate, "dd/mm/yyyy") & " at row : " & RowNumEnd

GoTo J1

error_Sdate:

Dim msg As String

msg = "You entered " & Format(dStartDate, "dd/mm/yyyy") & " as your Start Date, but no referrals were made on that date"
msg = msg & vbCrLf & "Please enter a different date in the Start Date box"
MsgBox msg, , "Start Date Not Found"
Err.Clear
Exit Sub

error_Edate:
msg = "You entered " & Format(dEndDate, "dd/mm/yyyy") & " as your End Date, but no referrals were made on that date"
msg = msg & vbCrLf & "Please enter a different date in the End Date box"
MsgBox msg, , "End Date Not Found"
Err.Clear
Exit Sub


J1:


'// Get Criteria From Form And Search Database Headers
Set Cr_1 = ws.Cells.Find(What:=Me.Count_Criteria_1.Value, After:=ws.Cells(1, 1), MatchCase:=False)

If Not Cr_1 Is Nothing Then

CR1 = Cr_1.Column '//Set CR1 as the Column in which the Criteria Header was found

Else
    MsgBox "Criteria 1 Has Not Been Found In The Database. Report Has Failed To Generate"
    Exit Sub
End If

'// Get Variable Value From Form And Set Shortcode
V_1 = Me.Criteria_1_Variable.Value

Set CR1_range = ws.Range(ws.Cells(RowNum, CR1), ws.Cells(RowNumEnd, CR1))
CR1_Result = Application.CountIf(CR1_range, V_1)

If Me.Count_Criteria_2 = "Any" Then

Me.Count_Result.visible = True

Me.Count_Result.Value = "Based On Your Search Criteria Of:" & vbNewLine & vbNewLine & _
"- " & Me.Count_Criteria_1.Value & ": " & Me.Criteria_1_Variable.Value & vbNewLine & vbNewLine & _
"The Results Are: " & CR1_Result & " entries found between the dates " & Format(dStartDate, "dd/mm/yyyy") & _
" and " & Format(dEndDate, "dd/mm/yyyy")

end sub

脚本将dStartDate设置为在设置页面中输入的日期(从脚本中的前面的表单中写入),并将dEndDate设置为结束日期。然后根据用户表单输入和基于用户表单的变量设置标准。

最后根据表格中输入的标准,变量和日期完成CountIf

需要花费很长时间才能使其正常工作,但现在我已成功设法同时使用此表单处理10个变量。除了VBA搞砸了日期的格式之外,现在它很有用。

感谢您的帮助!

编辑:( OnError的注释用于测试,显示行号的MsgBox应该被注释掉,但不用于测试)