-1

我有一个用户表单，允许用户输入“从”和“到”日期来搜索与用户选择的日期范围相对应的数据。在电子表格中，日期在 A 列中，并且有一系列与该日期对应的数据在以下列中的每一行到 W 列。我正在尝试开发一个可以获取这两个日期并查看的代码仅在日期落在 A 列中输入的日期范围内的行中，然后计算日期在指定范围内的行中每一列中的响应。然后，我想将计数值放入同一工作簿中单独工作表中每个响应计数的特定单元格中。每个可能的响应列都有 6 个定义的响应，

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

编辑：

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

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

是的，我的意思是说它需要过滤掉指定日期范围内的 A 列响应，然后为满足列日期条件的行中的 16 列中的每一列运行每个可能的响应的计数A. 这有意义吗？

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

在尝试自动过滤后，我尝试将其作为计数并复制和粘贴每列的每个可能响应，但实际上并没有过滤它。似乎即使我让它工作，这也不是最有效的方法。这是一列的两个响应的代码，作为我的编码尝试的示例（完整的代码占 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

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

4

2 回答 2

0

Something like this might work - where your OK button on your userform is CommandButton1 and your to and from textboxes are ToDateBox and FromDateBox. The bwlow would go in your userform code module.

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

Give it a try.. Working with dates can be a bit funny though, you need to make sure the dates being brought in from your userform and assigned to the variables are in the same format as the dates in the range you're searching or it can give some really wily results...

于 2014-08-25T23:47:49.953 回答
0

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

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六个可能的响应。基于 Record Macro，我相信您可以根据需要进行调整（如果差不多！）或返回更多详细信息以寻求帮助。

于 2013-09-03T20:18:01.887 回答