Question

我有一个userform，允许用户输入“from”和“to”日期来搜索与用户选择的日期范围相对应的数据。在电子表格中，日期位于A列中，并且对于通过列W的每一行，有一系列数据对应于以下列中的该日期。我正在尝试开发一个可以采用这两个日期并查看的代码仅在日期落入列A中输入日期范围的行中，然后计算具有指定范围内日期的行中每列中的响应。然后，我想将计数值放入同一工作簿中单独工作表中每个响应计数的特定单元格中。每个可能的响应列有6个定义的响应，因此countif函数在我看来是最合乎逻辑的。

这听起来相当复杂，但这是我总结它的最佳方式。我愿意使用自动过滤器或其他任何东西，但必须使用vba完成，如果它使用自动过滤器，则必须将其返回到子末尾的预自动过滤器屏幕。

编辑：

好吧，我想我不太清楚。对于您的第一个问题，其归因于W的原因是因为每行关联的其他几个项目不一定与此分析相关。具有相关数据响应的列是列D到W.每行只输入一个日期，并且在列A中（您可以忽略/跳过列B和C列）。对于每一列（在本例中为调查问题），可以输入6个已定义的可能响应。

因此，例如，D3可以说“非常同意”，“有点同意”，“有点不同意”，“非常不同意”，“没有回应”或“不确定/不适用”。对于与每列相关的所有问题都是如此。因此，我希望能够提取一个日期落在两个指定日期（范围的开始日期和结束日期）之内的行，然后查看该行到列D到W并计算6的数量。每列（或“问题”）的可能响应（如上所述）。然后，我希望将每列中每个可能响应的计数值复制到另一个工作表中的特定单元格（在本例中为Sheet3）。

是的，我的意思是说它需要过滤掉在指定日期范围内的A列响应，然后针对符合日期的行中的16列中的每一列运行每个可能响应的countifs A栏的标准。这有意义吗？

我愿意使用任何类型的高级过滤器或自动过滤器，但是如果有其他想法可以根据两个用户表单指定日期对A列中的日期进行排序，那么请查看16个问题列的相应行并计算每个问题的6个可能响应中的每一个的数量，并将该计数放入另一个工作表（Sheet3）上的指定单元格中。

尝试自动过滤后，我尝试将其作为countif并复制并粘贴每列的每个可能响应，但实际上并没有过滤它。看起来即使我让它工作，这也不是最有效的方法。以下是一列的两个响应的代码作为我的编码尝试的示例（完整代码占15列的6个可能响应，因此在此处包含它似乎过长）：

 Private Sub cbOkDateEnter_Click()

Dim ws As Worksheet
    Set ws1 = ThisWorkbook01.Sheets("Sheet1")

With Range("A1:W" & lr)
    .AutoFilter Field:=1, Criteria1:=">=" & tbEnterDate01, Operator:=xlAnd,          Criteria2:="<=" & tbEnterDate02

Dim sum01a, sum01b as Variant

sum01a = Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("D2:D5000"),     "Strongly disagree")
    Worksheets("Sheet3").Range("J12").Value = sum01a
sum01b = Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("D2:D5000"), "Somewhat disagree")
    Worksheets("Sheet3").Range("J13").Value = sum01b
End Sub

任何帮助将不胜感激！谢谢！

Answer 1

我不确定为什么你使用15列的ColumnW（真的不知道它在哪里！）但我很好奇这是否有任何帮助（对于在新表中运行）：

Sub Macro1()
    Range("D3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIFS(Sheet1!R2C1:R5000C1,"">=""&R1C1,Sheet1!R2C1:R5000C1,""<=""&R2C1,Sheet1!R2C:R5000C,RC1)"
    ActiveCell.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Range("E3:W3").Select
    ActiveSheet.Paste
    Range("D3:W3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D4:D8").Select
    ActiveSheet.Paste
End Sub

这假定：在该表（不是Sheet1）中，A1包含您的开始日期，A2您的结束日期和A3:A8您的六个可能回复。根据记录宏，我相信你可以根据需要进行调整（如果差不多！）或者回来提供更多详细信息以获得帮助。

Answer 2

这样的东西可能会起作用 - 你的用户窗体上的OK按钮是CommandButton1，你的往返文本框是ToDateBox和FromDateBox。 bwlow会进入你的用户表单代码模块。

Private Sub CommandButton1_Click()

Dim CountOpt1, CountOpt2, CountOpt3, CountOpt4, CountOpt5, CountOpt6 As Long

Dim DateArray() As Variant
Dim DateRange As Range

Dim DateStart, DateEnd As String

Dim DateCount, ColCount As Double

' Sort your data in date order so the range you're searching for is contiguous

    Sheets("Sheet1").UsedRange.Columns.Sort key1:=Range("A2"), Header1:=xlYes, order1:=xlAscending

' Set the formatting on the output from your userform
' This works for me, but you'll have to figure out how your dates are formatted so the macro can find them...
    DateStart = Format(FromDateBox.Value, ddmmyyyy)
    DateEnd = Format(ToDateBox.Value, ddmmyyyy)

' Set the width of your range to the ColCount variable
    ColCount = Sheets("Sheet1").UsedRange.Columns.Count

' Set the height of your range to the DateCount variable depending on instances of dates between your input range
    DateCount = Application.WorksheetFunction.CountIfs(Range("Sheet1!A:A"), _
    ">=" & DateStart, Range("Sheet1!A:A"), "<=" & DateEnd)


' Find earliest occurence of start date and set it to the DateRange variable
    Do While DateRange Is Nothing
        With Sheets("Sheet1").Range("A:A")
            Set DateRange = .Find(What:=DateStart, _
            After:=.Cells(.Cells.Count), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False)
                If DateRange Is Nothing Then
                    DateStart = DateAdd("d", 1, DateStart)
                    DateStart = Format(DateStart, ddmmyyyy)
                End If
        End With
    Loop

' Expand the DateRange variable to exclude the dates (and columns B & C with unrelated data)
' and then encompass all the rows within your target date range
    Set DateRange = DateRange.Offset(0, 3)
    Set DateRange = DateRange.Resize(DateCount, ColCount - 3)

' Add the DateRange to a 2D array
    DateArray = DateRange

' Loop through the array counting instances of your answers
For Each c In DateArray
    If c = "Strongly Agree" Then CountOpt1 = CountOpt1 + 1
    If c = "Somewhat Agree" Then CountOpt2 = CountOpt2 + 1
    If c = "Somewhat Disagree" Then CountOpt3 = CountOpt3 + 1
    If c = "Strongly Disagree" Then CountOpt4 = CountOpt4 + 1
    If c = "No Response" Then CountOpt5 = CountOpt5 + 1
    If c = "Not Sure/Not Applicable" Then CountOpt6 = CountOpt6 + 1
Next c

' Activate the sheet you want to dump the counts
Sheets("Sheet3").Activate

' Put the counts wherever you want - for example
Range("A1") = "Option 1"
Range("B1") = CountOpt1
Range("A2") = "Option 2"
Range("B2") = CountOpt2
Range("A3") = "Option 3"
Range("B3") = CountOpt3
Range("A4") = "Option 4"
Range("B4") = CountOpt4
Range("A5") = "Option 5"
Range("B5") = CountOpt5
Range("A6") = "Option 6"
Range("B6") = CountOpt6

' Unload the userform if you want
Unload Me

End Sub

尝试一下..使用日期可能会有点滑稽，但是您需要确保从用户表单引入并分配给变量的日期与您在＆＃范围内的日期格式相同39;重新搜索或者它可以给出一些非常狡猾的结果......

从两个指定日期之间的行中的单元格的值的CountIf到VBA的不同工作表

2 个答案: