使用VBA在Excel中反堆积列

艾丹·兰伯特

我在三列中有一个数据集,其中包括第一列中的一组重复的UUID,第二列中的每个UUID的字符串响应以及第三列中的每个响应的代码。我需要将其分为多组列,每组重复的UUID一组。请参见下图:

我有:

UUID    RESPONSE    Resp. Code 
id1     String1     Code1
id2     String2     Code7
id3     String3     Code3
id1     String4     Code3
id2     String5     Code5
id3     String6     Code1

我需要:

UUID    RESPONSE    Resp. Code  RESPONSE    Resp. Code 
id1     String1     Code1       String4     Code3
id2     String2     Code7       String5     Code5
id3     String3     Code3       String6     Code1

请注意,虽然此处显示了3个UUID,但实际上我正在处理1377。

我试图为此操作编写一个宏(粘贴在下面),但是我对VBA和Excel宏完全陌生,因此它很hacky,甚至无法关闭我想要的宏。

    Sub DestackColumns()
    Dim rng As Range
    Dim iCell As Integer
    Dim lastCol As Integer
    Dim iCol As Integer

    Set rng = ActiveCell.CurrentRegion
    lastCol = rng.Rows(1).Columns.Count

    For iCell = 3 To rng.Rows.Count Step 3
        Range(Cells(1, iCell), Cells(2, iCell)).Cut
        ActiveSheet.Paste Destination:=Cells(lastCol, 1)
    Next iCell
    End Sub

所有帮助表示赞赏!

罗恩·罗森菲尔德

这是有些不同的方法。我已经建立了一个名为cUUID的用户定义类。该类具有UUID,Response,ResponseCode和由成对的Response和ResponseCode组成的Collection的属性。

我们创建该类对象的Collection,其中该集合的每个成员都是一个特定的UUID(因为这就是您要对它们进行分组的方式)。

代码遍历数据源,“动态”创建这些对象。然后,我们创建一个包含所有结果的数组,并将该数组写入另一个工作表。

在代码中,如何更改这些工作表名称以及必要时更改源数据和结果的位置应该很明显。

插入类模块后,必须选择它,F4并将其重命名为cUUID

类模块

Option Explicit
Private pUUID As String
Private pResponse As String
Private pRespCode As String
Private pCol As Collection

Public Property Get UUID() As String
    UUID = pUUID
End Property
Public Property Let UUID(Value As String)
    pUUID = Value
End Property

Public Property Get Response() As String
    Response = pResponse
End Property
Public Property Let Response(Value As String)
    pResponse = Value
End Property

Public Property Get RespCode() As String
    RespCode = pRespCode
End Property
Public Property Let RespCode(Value As String)
    pRespCode = Value
End Property

Public Property Get Col() As Collection
    Set Col = pCol
End Property

Public Sub Add(Resp1 As String, RC As String)
    Dim V(1 To 2) As Variant
    V(1) = Resp1
    V(2) = RC
    Col.Add V
End Sub

Private Sub Class_Initialize()
    Set pCol = New Collection
End Sub


Private Sub Class_Terminate()
    Set pCol = Nothing
End Sub

常规模块

Option Explicit
Sub ConsolidateUUIDs()
    Dim cU As cUUID, colU As Collection
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes() As Variant
    Dim RespPairs As Long
    Dim I As Long, J As Long

Set wsSrc = Worksheets("Sheet1")
Set wsRes = Worksheets("Sheet2")
Set rRes = wsRes.Cells(1, 1)

With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, "C").End(xlUp))
End With

'Collect the data
Set colU = New Collection
RespPairs = 1
On Error Resume Next
For I = 2 To UBound(vSrc)
    Set cU = New cUUID
    With cU
        .UUID = vSrc(I, 1)
        .Response = vSrc(I, 2)
        .RespCode = vSrc(I, 3)
        .Add .Response, .RespCode
        colU.Add cU, CStr(.UUID)
        Select Case Err.Number
            Case 457
                Err.Clear
                colU(CStr(.UUID)).Add .Response, .RespCode
                J = colU(CStr(.UUID)).Col.Count
                RespPairs = IIf(J > RespPairs, J, RespPairs)
            Case Is <> 0
                Debug.Print Err.Number, Err.Description
                Stop
        End Select
    End With
Next I
On Error GoTo 0

'Sort Collection by UUID
CollectionBubbleSort colU, "UUID"

'Create Results Array
ReDim vRes(0 To colU.Count, 0 To RespPairs * 2)

'header row
vRes(0, 0) = "UUID"
For J = 0 To RespPairs - 1
    vRes(0, J * 2 + 1) = "RESPONSE"
    vRes(0, J * 2 + 2) = "Resp.Code"
Next J

'Data rows
For I = 1 To colU.Count
    With colU(I)
        vRes(I, 0) = .UUID
        For J = 1 To colU(I).Col.Count
            vRes(I, (J - 1) * 2 + 1) = colU(I).Col(J)(1)
            vRes(I, (J - 1) * 2 + 2) = colU(I).Col(J)(2)
        Next J
    End With
Next I

'Write the results array
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2) + 1)
With rRes
    .EntireColumn.Clear
    .Value = vRes
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .EntireColumn.AutoFit
End With

End Sub

'-------------------------------------------------------
'Could use faster sort routine if necessary
Sub CollectionBubbleSort(TempCol As Collection, Optional Prop As String = "")
'Must manually insert element of collection to sort on in this version
    Dim I As Long
    Dim NoExchanges As Boolean

    ' Loop until no more "exchanges" are made.
    Do
        NoExchanges = True

        ' Loop through each element in the array.
        For I = 1 To TempCol.Count - 1

If Prop = "" Then

            ' If the element is greater than the element
            ' following it, exchange the two elements.
            If TempCol(I) > TempCol(I + 1) Then
                NoExchanges = False
                TempCol.Add TempCol(I), after:=I + 1
                TempCol.Remove I
            End If
Else
        If CallByName(TempCol(I), Prop, VbGet) > CallByName(TempCol(I + 1), Prop, VbGet) Then
                NoExchanges = False
                TempCol.Add TempCol(I), after:=I + 1
                TempCol.Remove I
            End If
End If
        Next I
    Loop While Not (NoExchanges)
End Sub

UUID将按字母顺序排序。该代码应与不同数量的UUID和对每个UUID的响应数量不同一起使用。

本文收集自互联网,转载请注明来源。

如有侵权,请联系[email protected] 删除。

编辑于
0

我来说两句

0条评论
登录后参与评论

相关文章

来自分类Dev

在Excel VBA中搜索多个列

来自分类Dev

在Excel VBA中重新排序多列

来自分类Dev

CanvasJS中的动态堆积列

来自分类Dev

使用VBA在Excel中向列输入多个文本

来自分类Dev

Excel:如何在同一张图上使用堆积值制作4个不同的列?

来自分类Dev

如何使用CSS更改移动设备中堆积列的顺序

来自分类Dev

使用Excel VBA复制列中的范围

来自分类Dev

在表Excel VBA中插入新列

来自分类Dev

在Excel 2013中使用VBA读取隐藏列的问题

来自分类Dev

如何使用VBA将数字格式填充到excel中的整个列中?

来自分类Dev

在Excel 2010中,使用宏和VBA比较列中的数据并突出显示值(如果不同)

来自分类Dev

使用VBA在Excel中查看和隐藏列

来自分类Dev

在Excel中合并两列,然后使用VBA作为一列导出到Access

来自分类Dev

在Excel VBA中按列排序

来自分类Dev

使用VBA For Loop连接Excel中的列

来自分类Dev

Excel中的VBA在列之间移动值

来自分类Dev

在Excel-Vba中复制多列

来自分类Dev

删除Excel VBA中的列范围

来自分类Dev

使用VBA在Excel中搜索

来自分类Dev

访问VBa-在Excel列中循环

来自分类Dev

如何使用VBA在Excel中打印不连续的列?

来自分类Dev

清除Excel VBA中的特定列集

来自分类Dev

使用ggplot2在R中堆积条形图(在Excel中是不可能的)

来自分类Dev

使用 VBA 比较 Excel 中的 3 列

来自分类Dev

在 Excel 列 VBA 中插入图像

来自分类Dev

使用列函数 - Excel VBA

来自分类Dev

如何仅删除 Excel VBA 中堆积条形图(甘特图)中不需要的额外图例条目?

来自分类Dev

如何通过 VBA 使用来自另一列的信息在 Excel 2013 中创建列?

来自分类Dev

使用vba检查列是否在excel中可见

Related 相关文章

热门标签

归档