1

我有 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

等等。我一直在思考这个问题，但似乎找不到一个好的方法。有没有一种有效的方法使数据集看起来像：

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

等等。有什么帮助或想法吗？

4

4 回答 4

0

我会先用宏重新排列数据，这样：

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]

那么很容易做你想做的事，只需创建一个数据透视表......如果需要进一步的帮助，请在评论中告诉我......

于 2013-07-26T20:44:48.607 回答
0

所以我有一个想法，它并不漂亮，但它可能会起作用...复制整个字段列并将其粘贴到新工作表中，使用数据选项卡并点击删除重复项，如果你转置它，那么你的第一行是字段，a , b, c, d 你可以删除这样的公式（未经测试）“=INDEX(Sheet1!B:B, MATCH($B$1,Sheet1!A1:A3,0))"

匹配中的搜索范围故意很小，并且没有 $ ，如果你向下拖动这个公式，它会搜索更远一点（A2：A4，A3：A5，等）一旦你得到所有它们，只需找到/替换所有 N /as 删除空白和你的好

如果我有时间，我会尝试制作一个更简洁的小宏...

于 2013-07-26T19:13:30.503 回答
0

对于一次性的，您可能只使用公式来确定一行所在的组，然后进行透视，正如其他人在您的问题的评论中所描述的那样。

但是，对于重复使用/减少麻烦，以下应该可以工作。

根据您在问题中所需的输出，这适用于您的测试数据和新工作表上的输出。

它在内存中工作，因此在扩展到数千个单元时应该具有良好的性能。

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

我希望这会有所帮助。

于 2013-07-26T21:31:10.110 回答
0

在大纲中：创建group1列的副本，将其过滤为大于0并删除这些值。用相应的组填充空白，然后旋转。

于 2013-07-26T19:48:25.157 回答