VBA如何计算列y中按date排列的值的实例？

我有一个关于如何实现我的目标的问题。 我想通过Excel VBAmacros使用Minitab格式的数据。 基本上，我有一台机器的testing数据，并收集各种属性和可变数据。 我有兴趣find符合几个标准的项目数量，并计算这个数字。 因此，更具体地说，在我的1stTimeYield列中，我想计算每个input'1'的序列号（失败以'X'开头），对于显示的每个date。 看下面的截图，对于2015年2月1日，我的总数应该是3。 我还需要计算这个date的序列号总数，在这个例子中是4个。我的目标是在2月1日获得5个数据集合的75％的第一个合格率。然后我需要input这个数据放到我在代码中创build的工作表上的相应行/列中（我将粘贴下面的代码）。 在find一种方法来比较我收集到的数据的date和我在表格中列出的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

我知道您一直在研究VBA解决scheme，但是如果使用公式，可以使用一些有效的非数组标准公式来实现您的结果¹。

你需要的第一件事是一个独特date的列表。 Excel将date视为数字，因此您可以在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&"")) 

根据需要填写。 当你用完date拉到列F，你会得到#REF! 错误。 别在那里填充

_{f 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"