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

Question

I have a question about how to achieve my goal. I am trying to get data in a format that I can use with Minitab via Excel VBA macro. Basically, I have test data from a machine, and that collects various attribute and variable data. I am interested in finding the number of items that meet several criteria, and counting that number. So, more specifically, in my 1stTimeYield column, I want to count each serial number that has a '1' entered (failures start with 'X'), for each date that is shown. Looking at the screenshot below, for 01-Feb-15, I should get a total number of 3 for my count. I also need to count the total number of serial numbers for this date, which in this case is 4. My goal is to get to the first pass yield, of 75% for the 5 data collections on Feb 1. I then need to enter this data into the respective rows/columns on the worksheet that I create in my code (I will paste the code below this text). The pasting of the counts I come up with should be relatively straight forward, after finding a way to compare the date I collected the counts for with the dates listed in the sheet that I make. Please ask clarification questions if you have them. Essentially, I am a little stumped as to how to efficiently and effectively get the data that I need by date.

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

I understand that you have been working on a VBA solution but if formulas will do, some efficient non-array standard formulas can be applied to achieve your results¹.

The first thing you need are a list of unique dates. Excel treats dates as numbers so you can retrieve a ranked unique list starting with this formula in F2,

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

Next is a COUNTIFS function that takes all of your conditrions into consideration in G2.

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

Your heavily redacted data left the question of the serial number column containing duplicates unanswered so I assumed that there may be duplicates. H2's formula is,

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

Your narrative was unclear on whether that count should contain the serial numbers starting with X so here is the same count with X's excluded in I2,

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

Fill down as necessary. When you run out of dates to pull into column F you will get a #REF! error. Stop filling down there.

¹ _{fwiw, if I did this in VBA, I'd be using Application.WorksheetFunction to mash up several of these functions into the VBA code both for code efficiency and expediency.}

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"