VBA如何按y列中的日期计算x列中值的实例？

Question

我对如何实现自己的目标有疑问。 我试图通过Excel VBA宏获取可以与Minitab一起使用的格式的数据。 基本上，我从一台机器上获得测试数据，并收集各种属性和变量数据。 我有兴趣查找满足几个条件的项目数量，并计算该数量。 因此，更具体地说，在我的1stTimeYield列中，我希望为显示的每个日期计算每个输入了“ 1”的序列号（失败以“ X”开头）。 看下面的屏幕截图，对于15年2月1日，我的总数应该为3。 我还需要计算该日期的序列号总数，在这种情况下为4。我的目标是对于2月1日的5个数据收集达到75％的首过合格率。然后，我需要输入将此数据放入我在代码中创建的工作表上的相应行/列中（我会将代码粘贴到此文本下方）。 在找到一种将我收集的计数日期与我的工作表中列出的日期进行比较的方法之后，我想出的计数的粘贴应该相对简单一些。 如果您有任何疑问，请询问。 从本质上讲，我对如何有效地按日期获取所需的数据有些困惑。

Sub Main()

    Dim iNumSheets As Long
    'Add new Worksheet; check if exists already
    Sheets.Add After:=Sheets(Sheets.Count)
    iNumSheets = Sheets.Count
    If SheetExist("FPY Data") Then
        Application.DisplayAlerts = False
        Sheets(iNumSheets).Delete
        Application.DisplayAlerts = True
        End
    Else
        Sheets(iNumSheets).Name = "FPY Data"
    End If

    'Create and Format the Date and Yield Comments
    Dim sDate As String
    Dim sYield As String
    Sheets("FPY Data").Select
    Cells(1, 1).Value = "Date"
    Cells(1, 2).Value = "First Pass"
    Cells(1, 3).Value = "Total Pass"
    Cells(1, 4).Value = "FPY (%)"
    Columns("A:A").ColumnWidth = 10.33
    Columns("B:B").ColumnWidth = 10.33
    Cells.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells(1, 1).Select

    'Find Dates and copy to Yield Worksheet
    Dim iRow As Long
    Dim wSheet As Worksheet
    Set wSheet = ThisWorkbook.Worksheets(1)
    iRow = wSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

    'Copy first date in data
    Dim iTemp As Long
    iTemp = 3
    Worksheets("FPY Data").Cells(2, 1).Value = Worksheets(1).Cells(2, 2).Value
    For iCounter = 3 To iRow        'Loop through data for dates

        If Worksheets(1).Cells(iCounter, 2).Value = Worksheets(1).Cells(iCounter - 1, 2).Value Then
            'Do not copy new date to FPY data
        Else
            'Copy Date to next available cell & increment counter
            Worksheets("FPY Data").Cells(iTemp, 1).Value = Worksheets(1).Cells(iCounter, 2).Value
            iTemp = iTemp + 1
        End If

    Next iCounter

    'Count number of First Time Passes


End Sub

Function SheetExist(strSheetName As String) As Boolean
    Dim i As Integer

    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = strSheetName Then
            SheetExist = True
            Exit Function
        End If
    Next i
End Function

Answer 1

我了解您一直在研究VBA解决方案，但如果可以使用公式，则可以应用一些有效的非数组标准公式来获得结果¹。

您需要的第一件事是唯一日期列表。 Excel将日期视为数字，因此您可以从F2中的此公式开始检索排名的唯一列表，

=SMALL($B:$B, COUNTIF($B:$B, "<="&$F1)+1)

接下来是一个COUNTIFS函数 ，它将G2中的所有条件考虑在内。

=COUNTIFS($B:$B, $F2,$D:$D, 1,$C:$C, "<>X*")

您的大量编辑数据使序列号列中的问题无法解决，因此我认为可能存在重复。 H2的公式是

=SUMPRODUCT(($B$2:$B$9999=$F2)/COUNTIF($C$2:$C$9999, $C$2:$C$9999&""))

您的叙述不清楚该计数是否应包含以X开头的序列号，因此这里的计数与I2中排除的X相同，

=SUMPRODUCT((($B$2:$B$9999=$F2)*(LEFT($C$2:$C$9999,1)<>"X"))/COUNTIF($C$2:$C$9999,$C$2:$C$9999&""))

根据需要填写。 当您用完日期进入F列时，您将获得#REF! 错误。 别在那儿加油了。

¹ _{再者，如果我在VBA中这样做，我将使用Application.WorksheetFunction将其中几个函数混入VBA代码中，以提高代码效率和便利性。}

Answer 2

'Find Last Row of FPY Data Worksheet
Set wSheet = ThisWorkbook.Worksheets("FPY Data")

'Fill First Pass Column
Cells(2, 2).Activate
ActiveCell.FormulaR1C1 = "=COUNTIFS(PartData!C,'FPY Data'!RC[-1],PartData!C[20],1,PartData!C[1],""<>X*"")"
iRow = wSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & iRow - 1)

'Fill Total Pass Column
Cells(2, 3).Activate
ActiveCell.FormulaR1C1 = "=COUNTIFS(PartData!C[-1],'FPY Data'!C[-2],PartData!C,""<>X*"")"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & iRow - 1)

'Fill Percentage field
Cells(2, 4).Activate
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]*100"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & iRow - 1)
Range(Cells(2, 4), Cells(iRow, 4)).Select
Selection.NumberFormat = "0.00"