VBA计数限制在两个date之间
我正在尝试执行一个COUNTIF,但是当涉及到定义范围时,要使用在前面的“查找”语句中find的行值。 通过显示我的代码可能更容易解释:
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
为什么?
我不知道这是否与你的问题有关,但我认为你是不正确地声明你的variables。 在你设置的范围段中,我假设你想要把所有这些variables设置为types范围,但是只有CR5_Range被声明为一个范围; 其他人都被宣布为变体。 虽然可以在一行中放置多个声明,但每个variables需要定义为Type,或者如果省略Type,它将默认为Variant Type。 这可能会导致一些有用的错误消息被忽略。 您的其他声明段存在同样的问题。
问题很可能是查找方法没有find任何东西。 这会给出这个错误。 date有时很难“查找”。 你可以检查看看结果(没有行)是什么都没有。 例如:debug.print .find(…..)是没有的如果返回TRUE,你的查找失败。
好的,感谢您的所有意见,我最终自己解决了这个问题:
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
设置为在设置页面中input的date(从脚本前面的表单写入)和dEndDate
作为结束date。 然后基于用户表单input和基于用户表单的variables设置标准。
最后一个CountIf
是基于标准,variables和dateinput的forms完成…
花了很长时间才得到它的工作,但现在我已经成功地设法处理与这种forms的10个variables在同一时间。 除了VBA的date格式化这个工程现在很好。
感谢你的帮助!
编辑:( OnError的评论出来testing,MsgBox的显示行号应注释掉,但不是为了testing)