VBA：arrays和countif

所有，

我在Excel VBA中为以下情况采取的方法挣扎：

从不同的工作表中我创build了VBA中的数组（4列：键，types，活动dateA，活动B的date），例如：

我决定不使用字典，因为数组的大小（汽车的数量）给出。 我也没有使用简单的复制粘贴macros+ countif。 首先，你是否同意VBA中的数组是最好的方法？

现在我想要在每个活动中汇总结果，如下所示：

所以现在我正在努力最好的办法是：1）循环在数组中的行，并在表中粘贴的值2）循环在表中的单元格，并find相应的汽车3）复制到一个单独的工作表并在表4中使用countif …）

你能帮忙build议吗？ 希望问题是清楚的。

Answer 1

添加一些帮手列（如果您愿意，可以稍后隐藏）

在单元格D2 ，公式是=MONTH(C2) ，单元格E2 =YEAR(C2) ，对于G和H也是一样的，但在列F

然后在你的结果表中我使用了公式

 =COUNTIFS($B$2:$B$4,$A8, $D$2:$D$4,MONTH(B$7),$E$2:$E$4,YEAR(B$7)) 

对于活动A，同样的公式可以用于活动B（但是使用列G和H而不是D和E来获得结果，不需要VBA

用vba方法更新

你也可以试试这个VBA方法。 您需要注意所有大写的注释，并更新您的input和输出。 该代码将采取您的input数组，并承担第2列后的一切活动date。 然后它将编译结果并写回表单。 这可以在任何date范围内工作，因为它会自动检测第一个和最后一个date（填充一年中的所有date）以及任何数量的活动。 由于它的灵活性，这里有很多循环，但是因为它们都是在数组/字典中处理的（即在内存中），所以不应该出现性能问题。 你可以用更less的数量来完成，但是不pipe数据集的大小如何，都应该在几秒钟内处理它，所以增加工作量并不值得。

 Option Explicit Public Sub GenerateResults() Dim arr As Variant, tmp As Variant, Dates() As Double, Results As Object Dim i As Long, j As Long, StartRow As Long, ResultsSeparator As Long Dim StartYear As Long, EndYear As Long, yr As Long, mo As Long Dim c ' ******UPDATE TO POINT AT YOUR ARRAY****** With Sheet1 arr = Range(.Cells(1, 1), .Cells(4, 5)).Value2 End With Set Results = CreateObject("Scripting.Dictionary") For j = 3 To UBound(arr, 2) If StartYear < Format(WorksheetFunction.Min(Application.Index(arr, 0, j)), "yyyy") Then StartYear = Format(WorksheetFunction.Min(Application.Index(arr, 0, j)), "yyyy") End If If EndYear < Format(WorksheetFunction.Max(Application.Index(arr, 0, j)), "yyyy") Then EndYear = Format(WorksheetFunction.Max(Application.Index(arr, 0, j)), "yyyy") End If Next j ' 1 to 12 for months in the year, 1 to 2 for each activitity. This could be adapated for more then 12 months ReDim Dates(1 To (1 + EndYear - StartYear) * 12, 1 To UBound(arr, 2) - 2) For i = LBound(arr) To UBound(arr) Set tmp = Nothing ' Add to dictionary if colour not in array If Not Results.exists(arr(i, 2)) Then Results.Add Key:=arr(i, 2), Item:=Dates ' Assign your data to a temporary array so we can change it tmp = Results(arr(i, 2)) ' Update data with activity dates For j = LBound(Dates, 2) To UBound(Dates, 2) tmp(12 * (Year(arr(i, 2 + j)) - StartYear) + Month(arr(i, 2 + j)), j) = tmp(12 * (Year(arr(i, 2 + j)) - StartYear) + Month(arr(i, 2 + j)), j) + 1 Next j ' Write data back to dictionary Results(arr(i, 2)) = tmp Next i Application.ScreenUpdating = False ' ******CHANGE TO WHERE YOUR WANT YOUR RESULTS****** ' Starting row of results (change to your output) StartRow = 7 ' How many rows do you want between Activity A and B etc. ResultsSeparator = 3 With Sheet1 For j = LBound(Dates, 2) To UBound(Dates, 2) With .Cells(StartRow + (j - 1) * (ResultsSeparator + Results.Count), 1) .Value2 = UCase("Activity " & Split(.Cells(1, j).Address, "$")(1)) .Font.Bold = True End With Next j StartRow = StartRow + 1 For j = LBound(Dates, 1) To UBound(Dates, 1) yr = StartYear + IIf(j Mod 12 = 0, (j / 12) - 1, WorksheetFunction.RoundDown(j / 12, 0)) mo = IIf(j > 12, j - 12 * IIf(j Mod 12 = 0, (j / 12) - 1, WorksheetFunction.RoundDown(j / 12, 0)), j) For i = LBound(Dates, 2) To UBound(Dates, 2) With .Cells(StartRow + (i - 1) * (ResultsSeparator + Results.Count), 1 + j) .Value2 = DateSerial(yr, mo, 1) .NumberFormat = "mmm-yy" End With Next i Next j StartRow = StartRow + 1 ' Loop through dictionary For Each c In Results.keys ' Write back results for Activity A For j = LBound(Dates, 2) To UBound(Dates, 2) With .Cells(StartRow + (j - 1) * (ResultsSeparator + Results.Count), 1) .Value2 = c Range(.Offset(0, 1), .Offset(0, UBound(Results(c), 1))) = Application.Transpose(Application.Index(Results(c), 0, j)) End With Next j ' Increase Row StartRow = StartRow + 1 Next c End With Application.ScreenUpdating = True End Sub