Question

我对如何实现目标有疑问。我试图以一种格式获取数据，我可以通过Excel VBA宏使用Minitab。基本上，我有来自机器的测试数据，并收集各种属性和变量数据。我有兴趣找到满足几个标准的项目数量，并计算这个数字。所以，更具体地说，在我的1stTimeYield列中，我想计算每个具有＆＃39; 1＆＃39;的序列号。对于显示的每个日期输入（失败以＆＃39; X＆＃39;开头）。看下面的截图，对于01年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 function，它会在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!错误。停止在那里填写。

¹_{fwiw，如果我在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"

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

2 个答案: