VBA循环显示没有数据透视表的摘要

时间:2017-12-07 12:12:55

标签: excel vba excel-vba

我在创建循环以解决我的表格数据时出现问题。 要使我的问题清楚,请参阅下图。

enter image description here

提前谢谢。

1 个答案:

答案 0 :(得分:3)

这可能是大规模的过度杀伤,但是如果你有一个你正在处理的大数据集会很快(我猜你是否可以手动或者这样做)使用数据透视表)。请查看评论并更新说明。它目前会输出到活动表格中的单元格ActiveSheet,但我建议将E2更新为您的实际工作表名称,并Public Sub Example() Dim rng As Range Dim tmpArr As Variant Dim Dict As Object, tmpDict As Object Dim i As Long, j As Long Dim v, key Set Dict = CreateObject("Scripting.Dictionary") ' Update to your sheet here With ActiveSheet ' You may need to modify this depending on where you range is stored Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2)) tmpArr = rng.Value For i = LBound(tmpArr, 1) To UBound(tmpArr, 1) ' Test if value exists in dictionary. If not add and set up the dictionary item If Not Dict.exists(tmpArr(i, 1)) Then Set tmpDict = Nothing Set tmpDict = CreateObject("Scripting.Dictionary") Dict.Add key:=tmpArr(i, 1), Item:=tmpDict End If ' Set nested dictionary to variable so we can edit it Set tmpDict = Nothing Set tmpDict = Dict(tmpArr(i, 1)) ' Test if value exists in nested Dictionary, add if not and initiate counter If Not tmpDict.exists(tmpArr(i, 2)) Then tmpDict.Add key:=tmpArr(i, 2), Item:=1 Else ' Increment counter if it already exists tmpDict(tmpArr(i, 2)) = tmpDict(tmpArr(i, 2)) + 1 End If ' Write nested Dictionary back to Main dictionary Set Dict(tmpArr(i, 1)) = tmpDict Next i ' Repurpose array for output setting to maximum possible size (helps with speed of code) ReDim tmpArr(LBound(tmpArr, 2) To UBound(tmpArr, 2), LBound(tmpArr, 1) To UBound(tmpArr, 1)) ' Set starting counters for array i = LBound(tmpArr, 1) j = LBound(tmpArr, 2) ' Convert dictionary and nested dictionary to flat output For Each key In Dict tmpArr(j, i) = key i = i + 1 For Each v In Dict(key) tmpArr(j, i) = v tmpArr(j + 1, i) = Dict(key)(v) i = i + 1 Next v Next key ' Reshape array to actual size ReDim Preserve tmpArr(LBound(tmpArr, 1) To UBound(tmpArr, 1), LBound(tmpArr, 2) To i - 1) ' Change this to the starting cell of your output With .Cells(2, 5) Range(.Offset(0, 0), .Cells(UBound(tmpArr, 2), UBound(tmpArr, 1))) = Application.Transpose(tmpArr) End With End With End Sub 更新到您想要的位置

node_modules/react-native-fbsdk/android/build.gradle