从vba中的数据列表创build一个连接的matrix(如外连接)

我有一个2列,看起来像:

field group1 a 1.2 b 0.2 c 2.4 field group2 a 0.2 c 0.8 field group3 c 0.6 d 0.8 

等等。 我一直在思考这一段时间,但似乎无法find一个好方法。 有没有一种有效的方法来使数据集看起来像:

 field group1 group2 group3 a 1.2 0.2 b 0.2 c 2.4 0.8 0.6 d 0.8 

等等。 任何帮助或想法?

对于一次性的,你可以用公式来做,只要用公式来标识一行所在的组,然后转动,就像其他人在你的问题的评论中所描述的那样。

但是,重复使用/less麻烦下面应该工作。

这对您的testing数据起作用,并根据问题中的所需输出在新的工作表上输出。

它在内存中工作,所以在扩展到数千个单元时应该有很好的性能。

 Sub blah() 'Declarations Dim outWs As Worksheet Dim inArr, outArr Dim vector(), groups() Dim outC As Collection Dim currentGroup As Long Dim i As Long, j As Long Dim key 'load data inArr = Selection.Value Set outC = New Collection 'iterate through For i = LBound(inArr, 1) To UBound(inArr, 1) If inArr(i, LBound(inArr, 2)) Like "field*" Then 'new group currentGroup = currentGroup + 1 ReDim Preserve groups(1 To currentGroup) groups(currentGroup) = inArr(i, LBound(inArr, 2) + 1) 'assign group name Else 'is a record/field key = inArr(i, LBound(inArr, 2)) 'retrieve existing, ignoring the exception thrown if key does not exist On Error Resume Next vector = outC(key) If Err.Number = 5 Then 'error raised when key does not exist ReDim vector(0 To currentGroup) vector(0) = key 'add key Else outC.Remove (key) 'the reference of item is immutable so we must remove and add again ReDim Preserve vector(0 To currentGroup) 'resize vector End If On Error GoTo 0 vector(currentGroup) = inArr(i, LBound(inArr, 2) + 1) 'assign value to current group in vector outC.Add vector, key 'add to results Erase vector End If Next i 'Process our results collection into an array suitable for dumping to a sheet ReDim outArr(1 To outC.Count, 1 To currentGroup + 1) For i = 1 To outC.Count For j = 0 To UBound(outC(i)) outArr(i, j + LBound(outArr, 2) - LBound(outC(i))) = outC(i)(j) Next j Next i 'dump data With ActiveWorkbook.Worksheets.Add .Range(.Cells(1, 2), .Cells(1, 1 + UBound(groups))).Value = groups .Range(.Cells(2, 1), .Cells(1 + UBound(outArr, 1), UBound(outArr, 2))).Value = outArr End With Exit Sub End Sub 

我希望有帮助。

所以我有一个想法,它不漂亮,但它可能会工作…复制您的整个领域的专栏,并将其粘贴到一个新的工作表,使用数据选项卡,并点击删除重复,如果转置,所以你的最上面一行是字段,一,b,c,d你可以删除一个公式就是这样(未经testing)“= INDEX(Sheet1!B:B,MATCH($ B $ 1,Sheet1!A1:A3,0))”

在匹配的search范围是故意小而没有$,如果你拖动这个公式,它会search更进一步(A2:A4,A3:A5等),一旦你得到所有人只是find/取代所有的N /删除空白和你的好

如果我有时间,我会试着把一个小的macros,这将是一个更清洁…

概要:创buildgroup1列的副本,将其过滤为大于0值并删除这些值。 用相应的组填充空白,然后旋转。

我将首先用一个macros重新排列数据,这样:

 Sub sa() For Each cl In Range("B2:B1000").Cells If IsNumeric(cl.Value) And Not IsEmpty(cl.Value) Then If Not IsNumeric(cl.Offset(-1, 0).Value) Then cl.Offset(0, 1).Value = cl.Offset(-1, 0).Value Else cl.Offset(0, 1).Value = cl.Offset(-1, 1).Value End If End If Next End Sub 

这样数据可以用这个列分配重新排列:

 [field] [value] [group] 

那么这将是很容易做你想做的,只是创build一个数据透视表…在评论中告诉我,如果需要进一步的帮助…